21. EPMO Open Source Coordination Office Redaction File Detail Report

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

21.1 Files compared

# Location File Last Modified
1 MCCF_EDI_TAS_P2_PRCA_4_5_332.zip\MCCF_EDI_TAS_P2_PRCA_4_5_332 PRCA_IB_EPAYMENTS_BUNDLE_4_0_V16.KID Fri Jan 25 20:08:10 2019 UTC
2 MCCF_EDI_TAS_P2_PRCA_4_5_332.zip\MCCF_EDI_TAS_P2_PRCA_4_5_332 PRCA_IB_EPAYMENTS_BUNDLE_4_0_V16.KID Wed Feb 27 19:18:01 2019 UTC

21.2 Comparison summary

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

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

21.4 Active regular expressions

No regular expressions were active.

21.5 Comparison detail

  1   KIDS Distr ibution sa ved on Dec  14, 2018@ 15:45:59
  2   V16 PRCA*4 .5*332 IB* 2.0*633
  3   **KIDS**:P RCA IB EPA YMENTS BUN DLE 4.0^PR CA*4.5*332 ^IB*2.0*63 3^
  4  
  5   **INSTALL  NAME**
  6   PRCA IB EP AYMENTS BU NDLE 4.0
  7   "BLD",1106 6,0)
  8   PRCA IB EP AYMENTS BU NDLE 4.0^^ 1^3181214^ y
  9   "BLD",1106 6,1,0)
  10   ^^1^1^3181 001^
  11   "BLD",1106 6,1,1,0)
  12   MCCF EDI T AS EPAYMEN TS BUILD 7 /8
  13   "BLD",1106 6,6.3)
  14   16
  15   "BLD",1106 6,10,0)
  16   ^9.63^2^2
  17   "BLD",1106 6,10,1,0)
  18   PRCA*4.5*3 32^1
  19   "BLD",1106 6,10,2,0)
  20   IB*2.0*633
  21   "BLD",1106 6,10,"B"," IB*2.0*633 ",2)
  22  
  23   "BLD",1106 6,10,"B"," PRCA*4.5*3 32",1)
  24  
  25   "BLD",1106 6,"KRN",0)
  26   ^9.67PA^77 9.2^20
  27   "BLD",1106 6,"KRN",.4 ,0)
  28   .4
  29   "BLD",1106 6,"KRN",.4 01,0)
  30   .401
  31   "BLD",1106 6,"KRN",.4 02,0)
  32   .402
  33   "BLD",1106 6,"KRN",.4 03,0)
  34   .403
  35   "BLD",1106 6,"KRN",.5 ,0)
  36   .5
  37   "BLD",1106 6,"KRN",.8 4,0)
  38   .84
  39   "BLD",1106 6,"KRN",3. 6,0)
  40   3.6
  41   "BLD",1106 6,"KRN",3. 8,0)
  42   3.8
  43   "BLD",1106 6,"KRN",9. 2,0)
  44   9.2
  45   "BLD",1106 6,"KRN",9. 8,0)
  46   9.8
  47   "BLD",1106 6,"KRN",19 ,0)
  48   19
  49   "BLD",1106 6,"KRN",19 .1,0)
  50   19.1
  51   "BLD",1106 6,"KRN",10 1,0)
  52   101
  53   "BLD",1106 6,"KRN",40 9.61,0)
  54   409.61
  55   "BLD",1106 6,"KRN",77 1,0)
  56   771
  57   "BLD",1106 6,"KRN",77 9.2,0)
  58   779.2
  59   "BLD",1106 6,"KRN",87 0,0)
  60   870
  61   "BLD",1106 6,"KRN",89 89.51,0)
  62   8989.51
  63   "BLD",1106 6,"KRN",89 89.52,0)
  64   8989.52
  65   "BLD",1106 6,"KRN",89 94,0)
  66   8994
  67   "BLD",1106 6,"KRN","B ",.4,.4)
  68  
  69   "BLD",1106 6,"KRN","B ",.401,.40 1)
  70  
  71   "BLD",1106 6,"KRN","B ",.402,.40 2)
  72  
  73   "BLD",1106 6,"KRN","B ",.403,.40 3)
  74  
  75   "BLD",1106 6,"KRN","B ",.5,.5)
  76  
  77   "BLD",1106 6,"KRN","B ",.84,.84)
  78  
  79   "BLD",1106 6,"KRN","B ",3.6,3.6)
  80  
  81   "BLD",1106 6,"KRN","B ",3.8,3.8)
  82  
  83   "BLD",1106 6,"KRN","B ",9.2,9.2)
  84  
  85   "BLD",1106 6,"KRN","B ",9.8,9.8)
  86  
  87   "BLD",1106 6,"KRN","B ",19,19)
  88  
  89   "BLD",1106 6,"KRN","B ",19.1,19. 1)
  90  
  91   "BLD",1106 6,"KRN","B ",101,101)
  92  
  93   "BLD",1106 6,"KRN","B ",409.61,4 09.61)
  94  
  95   "BLD",1106 6,"KRN","B ",771,771)
  96  
  97   "BLD",1106 6,"KRN","B ",779.2,77 9.2)
  98  
  99   "BLD",1106 6,"KRN","B ",870,870)
  100  
  101   "BLD",1106 6,"KRN","B ",8989.51, 8989.51)
  102  
  103   "BLD",1106 6,"KRN","B ",8989.52, 8989.52)
  104  
  105   "BLD",1106 6,"KRN","B ",8994,899 4)
  106  
  107   "MBREQ")
  108   0
  109   "QUES","XP F1",0)
  110   Y
  111   "QUES","XP F1","??")
  112   ^D REP^XPD H
  113   "QUES","XP F1","A")
  114   Shall I wr ite over y our |FLAG|  File
  115   "QUES","XP F1","B")
  116   YES
  117   "QUES","XP F1","M")
  118   D XPF1^XPD IQ
  119   "QUES","XP F2",0)
  120   Y
  121   "QUES","XP F2","??")
  122   ^D DTA^XPD H
  123   "QUES","XP F2","A")
  124   Want my da ta |FLAG|  yours
  125   "QUES","XP F2","B")
  126   YES
  127   "QUES","XP F2","M")
  128   D XPF2^XPD IQ
  129   "QUES","XP I1",0)
  130   YO
  131   "QUES","XP I1","??")
  132   ^D INHIBIT ^XPDH
  133   "QUES","XP I1","A")
  134   Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  135   "QUES","XP I1","B")
  136   NO
  137   "QUES","XP I1","M")
  138   D XPI1^XPD IQ
  139   "QUES","XP M1",0)
  140   PO^VA(200, :EM
  141   "QUES","XP M1","??")
  142   ^D MG^XPDH
  143   "QUES","XP M1","A")
  144   Enter the  Coordinato r for Mail  Group '|F LAG|'
  145   "QUES","XP M1","B")
  146  
  147   "QUES","XP M1","M")
  148   D XPM1^XPD IQ
  149   "QUES","XP O1",0)
  150   Y
  151   "QUES","XP O1","??")
  152   ^D MENU^XP DH
  153   "QUES","XP O1","A")
  154   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  155   "QUES","XP O1","B")
  156   NO
  157   "QUES","XP O1","M")
  158   D XPO1^XPD IQ
  159   "QUES","XP Z1",0)
  160   Y
  161   "QUES","XP Z1","??")
  162   ^D OPT^XPD H
  163   "QUES","XP Z1","A")
  164   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  165   "QUES","XP Z1","B")
  166   NO
  167   "QUES","XP Z1","M")
  168   D XPZ1^XPD IQ
  169   "QUES","XP Z2",0)
  170   Y
  171   "QUES","XP Z2","??")
  172   ^D RTN^XPD H
  173   "QUES","XP Z2","A")
  174   Want to MO VE routine s to other  CPUs
  175   "QUES","XP Z2","B")
  176   NO
  177   "QUES","XP Z2","M")
  178   D XPZ2^XPD IQ
  179   "VER")
  180   8.0^22.2
  181   **INSTALL  NAME**
  182   PRCA*4.5*3 32
  183   "BLD",1060 1,0)
  184   PRCA*4.5*3 32^ACCOUNT S RECEIVAB LE^0^31812 14^y
  185   "BLD",1060 1,1,0)
  186   ^^1^1^3180 726^^
  187   "BLD",1060 1,1,1,0)
  188   MCCF EDI T AS EPAYMEN TS BUILD 3
  189   "BLD",1060 1,4,0)
  190   ^9.64PA^34 2^3
  191   "BLD",1060 1,4,342,0)
  192   342
  193   "BLD",1060 1,4,342,2, 0)
  194   ^9.641^342 ^1
  195   "BLD",1060 1,4,342,2, 342,0)
  196   AR SITE PA RAMETER  ( File-top l evel)
  197   "BLD",1060 1,4,342,2, 342,1,0)
  198   ^9.6411^7. 09^1
  199   "BLD",1060 1,4,342,2, 342,1,7.09 ,0)
  200   AUTO-AUDIT  TRICARE E DI BILLS
  201   "BLD",1060 1,4,342,22 2)
  202   y^y^p^^^^n ^^n
  203   "BLD",1060 1,4,342,22 4)
  204  
  205   "BLD",1060 1,4,344.5, 0)
  206   344.5
  207   "BLD",1060 1,4,344.5, 2,0)
  208   ^9.641^344 .5^1
  209   "BLD",1060 1,4,344.5, 2,344.5,0)
  210   AR EDI LOC KBOX MESSA GES  (File -top level )
  211   "BLD",1060 1,4,344.5, 2,344.5,1, 0)
  212   ^9.6411^.1 5^1
  213   "BLD",1060 1,4,344.5, 2,344.5,1, .15,0)
  214   DUPLICATE  INDICATOR
  215   "BLD",1060 1,4,344.5, 222)
  216   y^y^p^^^^n ^^n
  217   "BLD",1060 1,4,344.5, 224)
  218  
  219   "BLD",1060 1,4,344.61 ,0)
  220   344.61
  221   "BLD",1060 1,4,344.61 ,2,0)
  222   ^9.641^344 .61^2
  223   "BLD",1060 1,4,344.61 ,2,344.61, 0)
  224   RCDPE PARA METER  (Fi le-top lev el)
  225   "BLD",1060 1,4,344.61 ,2,344.61, 1,0)
  226   ^9.6411^.0 7^5
  227   "BLD",1060 1,4,344.61 ,2,344.61, 1,.07,0)
  228   PHARMACY E FT POST PR EVENT DAYS
  229   "BLD",1060 1,4,344.61 ,2,344.61, 1,.13,0)
  230   TRICARE EF T POST PRE VENT DAYS
  231   "BLD",1060 1,4,344.61 ,2,344.61, 1,26,0)
  232   TRICARE EF T OVERRIDE
  233   "BLD",1060 1,4,344.61 ,2,344.61, 1,27,0)
  234   USER - TRI CARE OVERR IDE
  235   "BLD",1060 1,4,344.61 ,2,344.61, 1,28,0)
  236   COMMENT -  TRICARE OV ERRIDE
  237   "BLD",1060 1,4,344.61 ,2,344.611 ,0)
  238   HISTORY  ( sub-file)
  239   "BLD",1060 1,4,344.61 ,2,344.611 ,1,0)
  240   ^9.6411^4^ 6
  241   "BLD",1060 1,4,344.61 ,2,344.611 ,1,.01,0)
  242   DATE
  243   "BLD",1060 1,4,344.61 ,2,344.611 ,1,.02,0)
  244   USER
  245   "BLD",1060 1,4,344.61 ,2,344.611 ,1,1,0)
  246   PARAMETER
  247   "BLD",1060 1,4,344.61 ,2,344.611 ,1,2,0)
  248   DETAIL
  249   "BLD",1060 1,4,344.61 ,2,344.611 ,1,3,0)
  250   OLD VALUE
  251   "BLD",1060 1,4,344.61 ,2,344.611 ,1,4,0)
  252   NEW VALUE
  253   "BLD",1060 1,4,344.61 ,222)
  254   y^n^p^^^^n ^^n
  255   "BLD",1060 1,4,344.61 ,224)
  256  
  257   "BLD",1060 1,4,"APDD" ,342,342)
  258  
  259   "BLD",1060 1,4,"APDD" ,342,342,7 .09)
  260  
  261   "BLD",1060 1,4,"APDD" ,344.5,344 .5)
  262  
  263   "BLD",1060 1,4,"APDD" ,344.5,344 .5,.15)
  264  
  265   "BLD",1060 1,4,"APDD" ,344.61,34 4.61)
  266  
  267   "BLD",1060 1,4,"APDD" ,344.61,34 4.61,.07)
  268  
  269   "BLD",1060 1,4,"APDD" ,344.61,34 4.61,.13)
  270  
  271   "BLD",1060 1,4,"APDD" ,344.61,34 4.61,26)
  272  
  273   "BLD",1060 1,4,"APDD" ,344.61,34 4.61,27)
  274  
  275   "BLD",1060 1,4,"APDD" ,344.61,34 4.61,28)
  276  
  277   "BLD",1060 1,4,"APDD" ,344.61,34 4.611)
  278  
  279   "BLD",1060 1,4,"APDD" ,344.61,34 4.611,.01)
  280  
  281   "BLD",1060 1,4,"APDD" ,344.61,34 4.611,.02)
  282  
  283   "BLD",1060 1,4,"APDD" ,344.61,34 4.611,1)
  284  
  285   "BLD",1060 1,4,"APDD" ,344.61,34 4.611,2)
  286  
  287   "BLD",1060 1,4,"APDD" ,344.61,34 4.611,3)
  288  
  289   "BLD",1060 1,4,"APDD" ,344.61,34 4.611,4)
  290  
  291   "BLD",1060 1,4,"B",34 2,342)
  292  
  293   "BLD",1060 1,4,"B",34 4.5,344.5)
  294  
  295   "BLD",1060 1,4,"B",34 4.61,344.6 1)
  296  
  297   "BLD",1060 1,6.3)
  298   34
  299   "BLD",1060 1,"ABPKG")
  300   n
  301   "BLD",1060 1,"INIT")
  302   POST^RCP33 2
  303   "BLD",1060 1,"KRN",0)
  304   ^9.67PA^77 9.2^20
  305   "BLD",1060 1,"KRN",.4 ,0)
  306   .4
  307   "BLD",1060 1,"KRN",.4 ,"NM",0)
  308   ^9.68A^^
  309   "BLD",1060 1,"KRN",.4 01,0)
  310   .401
  311   "BLD",1060 1,"KRN",.4 02,0)
  312   .402
  313   "BLD",1060 1,"KRN",.4 02,"NM",0)
  314   ^9.68A^^
  315   "BLD",1060 1,"KRN",.4 03,0)
  316   .403
  317   "BLD",1060 1,"KRN",.5 ,0)
  318   .5
  319   "BLD",1060 1,"KRN",.8 4,0)
  320   .84
  321   "BLD",1060 1,"KRN",3. 6,0)
  322   3.6
  323   "BLD",1060 1,"KRN",3. 8,0)
  324   3.8
  325   "BLD",1060 1,"KRN",9. 2,0)
  326   9.2
  327   "BLD",1060 1,"KRN",9. 8,0)
  328   9.8
  329   "BLD",1060 1,"KRN",9. 8,"NM",0)
  330   ^9.68A^44^ 43
  331   "BLD",1060 1,"KRN",9. 8,"NM",1,0 )
  332   RCDPEMAP^^ 0^B1056956 06
  333   "BLD",1060 1,"KRN",9. 8,"NM",2,0 )
  334   RCDPEMA1^^ 0^B7290759 4
  335   "BLD",1060 1,"KRN",9. 8,"NM",3,0 )
  336   RCDPEFTL^^ 0^B8496166 6
  337   "BLD",1060 1,"KRN",9. 8,"NM",4,0 )
  338   RCDPESR2^^ 0^B9319387 3
  339   "BLD",1060 1,"KRN",9. 8,"NM",5,0 )
  340   RCDPEX5^^0 ^B66895490
  341   "BLD",1060 1,"KRN",9. 8,"NM",6,0 )
  342   RCDPESR6^^ 0^B5896791 0
  343   "BLD",1060 1,"KRN",9. 8,"NM",7,0 )
  344   RCDPEX1^^0 ^B23011676
  345   "BLD",1060 1,"KRN",9. 8,"NM",8,0 )
  346   RCDPESP6^^ 0^B6524072 6
  347   "BLD",1060 1,"KRN",9. 8,"NM",9,0 )
  348   RCDPEP^^0^ B154349379
  349   "BLD",1060 1,"KRN",9. 8,"NM",10, 0)
  350   RCDPESP8^^ 0^B2220930 0
  351   "BLD",1060 1,"KRN",9. 8,"NM",11, 0)
  352   RCDPRLIS^^ 0^B1436354 02
  353   "BLD",1060 1,"KRN",9. 8,"NM",12, 0)
  354   RCDPEAC^^0 ^B16999541 7
  355   "BLD",1060 1,"KRN",9. 8,"NM",13, 0)
  356   RCDPENR3^^ 0^B2106526 13
  357   "BLD",1060 1,"KRN",9. 8,"NM",14, 0)
  358   RCDPEARL^^ 0^B4172558 4
  359   "BLD",1060 1,"KRN",9. 8,"NM",15, 0)
  360   RCDPRSEA^^ 0^B8572524 8
  361   "BLD",1060 1,"KRN",9. 8,"NM",16, 0)
  362   RCDPEM2^^0 ^B14658571 0
  363   "BLD",1060 1,"KRN",9. 8,"NM",17, 0)
  364   RCDPEU1^^0 ^B12189342 8
  365   "BLD",1060 1,"KRN",9. 8,"NM",18, 0)
  366   RCDPEWL7^^ 0^B2408348 71
  367   "BLD",1060 1,"KRN",9. 8,"NM",19, 0)
  368   RCDPEE^^0^ B114741630
  369   "BLD",1060 1,"KRN",9. 8,"NM",20, 0)
  370   RCDPESP^^0 ^B14222928 7
  371   "BLD",1060 1,"KRN",9. 8,"NM",21, 0)
  372   RCDPESP1^^ 0^B1138713 39
  373   "BLD",1060 1,"KRN",9. 8,"NM",22, 0)
  374   RCDPEUPO^^ 0^B4734955 1
  375   "BLD",1060 1,"KRN",9. 8,"NM",23, 0)
  376   RCDPEWLP^^ 0^B2011143 17
  377   "BLD",1060 1,"KRN",9. 8,"NM",24, 0)
  378   RCDPESPA^^ 0^B7201526 5
  379   "BLD",1060 1,"KRN",9. 8,"NM",26, 0)
  380   RCDPESP2^^ 0^B1010414 66
  381   "BLD",1060 1,"KRN",9. 8,"NM",27, 0)
  382   RCDPESP5^^ 0^B2689467 94
  383   "BLD",1060 1,"KRN",9. 8,"NM",28, 0)
  384   RCBEUTRA^^ 0^B3099859 6
  385   "BLD",1060 1,"KRN",9. 8,"NM",29, 0)
  386   RCBEADJ1^^ 0^B1858602 1
  387   "BLD",1060 1,"KRN",9. 8,"NM",30, 0)
  388   RCDPEM9^^0 ^B81919705
  389   "BLD",1060 1,"KRN",9. 8,"NM",31, 0)
  390   RCDPEWLZ^^ 0^B2390683 1
  391   "BLD",1060 1,"KRN",9. 8,"NM",32, 0)
  392   RCDPRPL4^^ 0^B3670732 9
  393   "BLD",1060 1,"KRN",9. 8,"NM",33, 0)
  394   RCDPRPLM^^ 0^B1011196 93
  395   "BLD",1060 1,"KRN",9. 8,"NM",34, 0)
  396   RCDPEM5^^0 ^B16981334 2
  397   "BLD",1060 1,"KRN",9. 8,"NM",35, 0)
  398   RCDPEU2^^0 ^B44759277
  399   "BLD",1060 1,"KRN",9. 8,"NM",36, 0)
  400   RCDPLPL3^^ 0^B6180821 1
  401   "BLD",1060 1,"KRN",9. 8,"NM",37, 0)
  402   RCDPLPL4^^ 0^B2487092 21
  403   "BLD",1060 1,"KRN",9. 8,"NM",38, 0)
  404   RCDPRPL2^^ 0^B5794975 4
  405   "BLD",1060 1,"KRN",9. 8,"NM",39, 0)
  406   PRCABJ2^^0 ^B20492059
  407   "BLD",1060 1,"KRN",9. 8,"NM",40, 0)
  408   PRCAEXM^^0 ^B15458126
  409   "BLD",1060 1,"KRN",9. 8,"NM",41, 0)
  410   RCDPEM4^^0 ^B21542127 6
  411   "BLD",1060 1,"KRN",9. 8,"NM",42, 0)
  412   RCDPEWL0^^ 0^B2223448 47
  413   "BLD",1060 1,"KRN",9. 8,"NM",43, 0)
  414   RCDPEAA3^^ 0^B1363369 24
  415   "BLD",1060 1,"KRN",9. 8,"NM",44, 0)
  416   RCDPAYER^^ 0^B2682659 3
  417   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"PRCABJ2" ,39)
  418  
  419   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"PRCAEXM" ,40)
  420  
  421   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCBEADJ1 ",29)
  422  
  423   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCBEUTRA ",28)
  424  
  425   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPAYER ",44)
  426  
  427   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEAA3 ",43)
  428  
  429   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEAC" ,12)
  430  
  431   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEARL ",14)
  432  
  433   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEE", 19)
  434  
  435   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEFTL ",3)
  436  
  437   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEM2" ,16)
  438  
  439   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEM4" ,41)
  440  
  441   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEM5" ,34)
  442  
  443   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEM9" ,30)
  444  
  445   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEMA1 ",2)
  446  
  447   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEMAP ",1)
  448  
  449   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPENR3 ",13)
  450  
  451   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEP", 9)
  452  
  453   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPESP" ,20)
  454  
  455   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPESP1 ",21)
  456  
  457   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPESP2 ",26)
  458  
  459   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPESP5 ",27)
  460  
  461   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPESP6 ",8)
  462  
  463   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPESP8 ",10)
  464  
  465   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPESPA ",24)
  466  
  467   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPESR2 ",4)
  468  
  469   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPESR6 ",6)
  470  
  471   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEU1" ,17)
  472  
  473   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEU2" ,35)
  474  
  475   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEUPO ",22)
  476  
  477   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEWL0 ",42)
  478  
  479   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEWL7 ",18)
  480  
  481   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEWLP ",23)
  482  
  483   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEWLZ ",31)
  484  
  485   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEX1" ,7)
  486  
  487   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPEX5" ,5)
  488  
  489   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPLPL3 ",36)
  490  
  491   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPLPL4 ",37)
  492  
  493   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPRLIS ",11)
  494  
  495   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPRPL2 ",38)
  496  
  497   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPRPL4 ",32)
  498  
  499   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPRPLM ",33)
  500  
  501   "BLD",1060 1,"KRN",9. 8,"NM","B" ,"RCDPRSEA ",15)
  502  
  503   "BLD",1060 1,"KRN",19 ,0)
  504   19
  505   "BLD",1060 1,"KRN",19 ,"NM",0)
  506   ^9.68A^56^ 56
  507   "BLD",1060 1,"KRN",19 ,"NM",1,0)
  508   RCDPE MARK ED AUTO-PO ST REPORT^ ^0
  509   "BLD",1060 1,"KRN",19 ,"NM",2,0)
  510   RCDPE EDI  LOCKBOX RE PORTS MENU ^^0
  511   "BLD",1060 1,"KRN",19 ,"NM",3,0)
  512   RCDPE EDI  LOCKBOX AC T REPORT^^ 4^
  513   "BLD",1060 1,"KRN",19 ,"NM",4,0)
  514   RCDPE EFT  AGING REPO RT^^4^
  515   "BLD",1060 1,"KRN",19 ,"NM",5,0)
  516   RCDPE ERA  AGING REPO RT^^4^
  517   "BLD",1060 1,"KRN",19 ,"NM",6,0)
  518   RCDPE VIEW /PRINT ERA ^^4^
  519   "BLD",1060 1,"KRN",19 ,"NM",7,0)
  520   RCDPE ACTI VE WITH EE OB REPORT^ ^4^
  521   "BLD",1060 1,"KRN",19 ,"NM",8,0)
  522   RCDPE REMO VED ERA AU DIT^^4^
  523   "BLD",1060 1,"KRN",19 ,"NM",9,0)
  524   RCDPE ERA  W/PAPER EO B REPORT^^ 4^
  525   "BLD",1060 1,"KRN",19 ,"NM",10,0 )
  526   RCDPE EFT  AUDIT REPO RT^^4^
  527   "BLD",1060 1,"KRN",19 ,"NM",11,0 )
  528   RCDPE EEOB  MOVE/COPY /RMOVE RPT ^^4^
  529   "BLD",1060 1,"KRN",19 ,"NM",12,0 )
  530   RCDPE AUTO -POST REPO RT^^4^
  531   "BLD",1060 1,"KRN",19 ,"NM",13,0 )
  532   RCDPE AUTO -DECREASE  REPORT^^4^
  533   "BLD",1060 1,"KRN",19 ,"NM",14,0 )
  534   RCDPE PAYE R EXCLUSIO N NAME TIN ^^4^
  535   "BLD",1060 1,"KRN",19 ,"NM",15,0 )
  536   RCDPE CARC /RARC TABL E REPORT^^ 4^
  537   "BLD",1060 1,"KRN",19 ,"NM",16,0 )
  538   RCDPE CARC /RARC QUIC K SEARCH^^ 4^
  539   "BLD",1060 1,"KRN",19 ,"NM",17,0 )
  540   RCDPE PROV IDER LVL A DJ REPORT^ ^4^
  541   "BLD",1060 1,"KRN",19 ,"NM",18,0 )
  542   RCDPE EFT  TRANSACTIO N AUD REP^ ^4^
  543   "BLD",1060 1,"KRN",19 ,"NM",19,0 )
  544   RCDPE CARC  CODE PAYE R REPORT^^ 4^
  545   "BLD",1060 1,"KRN",19 ,"NM",20,0 )
  546   RCDPE ERA  STATUS CHN G AUD REP^ ^4^
  547   "BLD",1060 1,"KRN",19 ,"NM",21,0 )
  548   RCDPE UNAP PLIED EFT  DEP REPORT ^^4^
  549   "BLD",1060 1,"KRN",19 ,"NM",22,0 )
  550   RCDPE AUTO -POST RECE IPT REPORT ^^4^
  551   "BLD",1060 1,"KRN",19 ,"NM",23,0 )
  552   RCDPE EFT  OVERRIDE R EPORT^^0^
  553   "BLD",1060 1,"KRN",19 ,"NM",24,0 )
  554   RCDPE EFT- ERA TRENDI NG REPORT^ ^4^
  555   "BLD",1060 1,"KRN",19 ,"NM",25,0 )
  556   RCDPE DUPL ICATE ERA  WORKLIST^^ 0
  557   "BLD",1060 1,"KRN",19 ,"NM",26,0 )
  558   RCDPE AUTO  PARAM HIS T REPORT^^ 0
  559   "BLD",1060 1,"KRN",19 ,"NM",27,0 )
  560   PRCA SITE  PARAMETER^ ^0
  561   "BLD",1060 1,"KRN",19 ,"NM",28,0 )
  562   PRCA NOTIF ICATION PA RAMETERS^^ 4^
  563   "BLD",1060 1,"KRN",19 ,"NM",29,0 )
  564   PRCA BIL A GENCY^^4^
  565   "BLD",1060 1,"KRN",19 ,"NM",30,0 )
  566   PRCAF U AD MIN.RATE^^ 4^
  567   "BLD",1060 1,"KRN",19 ,"NM",31,0 )
  568   PRCA DEACT IVATE GROU P^^4^
  569   "BLD",1060 1,"KRN",19 ,"NM",32,0 )
  570   PRCA RC PA RAMETERS^^ 4^
  571   "BLD",1060 1,"KRN",19 ,"NM",33,0 )
  572   RCDPE EDI  LOCKBOX PA RAMETERS^^ 4^
  573   "BLD",1060 1,"KRN",19 ,"NM",34,0 )
  574   PRCA CBO P ARAMETERS^ ^4^
  575   "BLD",1060 1,"KRN",19 ,"NM",35,0 )
  576   RCDPE SITE  PARAMETER  REPORT^^4 ^
  577   "BLD",1060 1,"KRN",19 ,"NM",36,0 )
  578   RCDPE PARA METER AUDI T REPORT^^ 4^
  579   "BLD",1060 1,"KRN",19 ,"NM",37,0 )
  580   RCDPE EXCL USION AUDI T REPORT^^ 4^
  581   "BLD",1060 1,"KRN",19 ,"NM",38,0 )
  582   RCDPE EDI  LOCKBOX ME NU^^0
  583   "BLD",1060 1,"KRN",19 ,"NM",39,0 )
  584   RCDPE EDI  LOCKBOX WO RKLIST^^4^
  585   "BLD",1060 1,"KRN",19 ,"NM",40,0 )
  586   RCDPE EXCE PTION PROC ESSING^^4^
  587   "BLD",1060 1,"KRN",19 ,"NM",41,0 )
  588   RCDPE MATC H EFT TO E RA^^4^
  589   "BLD",1060 1,"KRN",19 ,"NM",42,0 )
  590   RCDPE MANU AL MATCH E FT-ERA^^0^
  591   "BLD",1060 1,"KRN",19 ,"NM",43,0 )
  592   RCDPE MARK  0-BAL EFT  MATCHED^^ 4^
  593   "BLD",1060 1,"KRN",19 ,"NM",44,0 )
  594   RCDPE ERA  POSTED BY  PAPER EOB^ ^4^
  595   "BLD",1060 1,"KRN",19 ,"NM",45,0 )
  596   RCDPE UNMA TCH ERA^^4 ^
  597   "BLD",1060 1,"KRN",19 ,"NM",46,0 )
  598   RCDPE REMO VE ERA FRO M WORKLIST ^^4^
  599   "BLD",1060 1,"KRN",19 ,"NM",47,0 )
  600   RCDPE REMO VE DUP DEP OSITS^^4^
  601   "BLD",1060 1,"KRN",19 ,"NM",48,0 )
  602   RCDPE UNPO STED EFT O VERRIDE^^4 ^
  603   "BLD",1060 1,"KRN",19 ,"NM",49,0 )
  604   RCDPE APAR ^^4^
  605   "BLD",1060 1,"KRN",19 ,"NM",50,0 )
  606   RCDPE PAYE R IDENTIFY ^^4^
  607   "BLD",1060 1,"KRN",19 ,"NM",51,0 )
  608   RCDPE EEOB  MOVE/COPY /REMOVE^^4 ^
  609   "BLD",1060 1,"KRN",19 ,"NM",52,0 )
  610   RCDP EXTEN DED CHECK/ CC SEARCH^ ^0
  611   "BLD",1060 1,"KRN",19 ,"NM",53,0 )
  612   RCDPE EDI  LOCKBOX AR SRCH RPRTS ^^0^
  613   "BLD",1060 1,"KRN",19 ,"NM",54,0 )
  614   RCDPE EDI  LOCKBOX AD JCDE RPRTS ^^0^
  615   "BLD",1060 1,"KRN",19 ,"NM",55,0 )
  616   RCDPE EDI  LOCKBOX AU DIT RPRTS^ ^0^
  617   "BLD",1060 1,"KRN",19 ,"NM",56,0 )
  618   RCDPE EDI  LOCKBOX WO RKLD RPRTS ^^0^
  619   "BLD",1060 1,"KRN",19 ,"NM","B", "PRCA BIL  AGENCY",29 )
  620  
  621   "BLD",1060 1,"KRN",19 ,"NM","B", "PRCA CBO  PARAMETERS ",34)
  622  
  623   "BLD",1060 1,"KRN",19 ,"NM","B", "PRCA DEAC TIVATE GRO UP",31)
  624  
  625   "BLD",1060 1,"KRN",19 ,"NM","B", "PRCA NOTI FICATION P ARAMETERS" ,28)
  626  
  627   "BLD",1060 1,"KRN",19 ,"NM","B", "PRCA RC P ARAMETERS" ,32)
  628  
  629   "BLD",1060 1,"KRN",19 ,"NM","B", "PRCA SITE  PARAMETER ",27)
  630  
  631   "BLD",1060 1,"KRN",19 ,"NM","B", "PRCAF U A DMIN.RATE" ,30)
  632  
  633   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDP EXTE NDED CHECK /CC SEARCH ",52)
  634  
  635   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE ACT IVE WITH E EOB REPORT ",7)
  636  
  637   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE APA R",49)
  638  
  639   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE AUT O PARAM HI ST REPORT" ,26)
  640  
  641   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE AUT O-DECREASE  REPORT",1 3)
  642  
  643   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE AUT O-POST REC EIPT REPOR T",22)
  644  
  645   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE AUT O-POST REP ORT",12)
  646  
  647   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE CAR C CODE PAY ER REPORT" ,19)
  648  
  649   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE CAR C/RARC QUI CK SEARCH" ,16)
  650  
  651   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE CAR C/RARC TAB LE REPORT" ,15)
  652  
  653   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE DUP LICATE ERA  WORKLIST" ,25)
  654  
  655   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EDI  LOCKBOX A CT REPORT" ,3)
  656  
  657   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EDI  LOCKBOX A DJCDE RPRT S",54)
  658  
  659   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EDI  LOCKBOX A RSRCH RPRT S",53)
  660  
  661   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EDI  LOCKBOX A UDIT RPRTS ",55)
  662  
  663   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EDI  LOCKBOX M ENU",38)
  664  
  665   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EDI  LOCKBOX P ARAMETERS" ,33)
  666  
  667   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EDI  LOCKBOX R EPORTS MEN U",2)
  668  
  669   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EDI  LOCKBOX W ORKLD RPRT S",56)
  670  
  671   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EDI  LOCKBOX W ORKLIST",3 9)
  672  
  673   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EEO B MOVE/COP Y/REMOVE", 51)
  674  
  675   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EEO B MOVE/COP Y/RMOVE RP T",11)
  676  
  677   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EFT  AGING REP ORT",4)
  678  
  679   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EFT  AUDIT REP ORT",10)
  680  
  681   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EFT  OVERRIDE  REPORT",23 )
  682  
  683   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EFT  TRANSACTI ON AUD REP ",18)
  684  
  685   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EFT -ERA TREND ING REPORT ",24)
  686  
  687   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE ERA  AGING REP ORT",5)
  688  
  689   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE ERA  POSTED BY  PAPER EOB ",44)
  690  
  691   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE ERA  STATUS CH NG AUD REP ",20)
  692  
  693   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE ERA  W/PAPER E OB REPORT" ,9)
  694  
  695   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EXC EPTION PRO CESSING",4 0)
  696  
  697   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE EXC LUSION AUD IT REPORT" ,37)
  698  
  699   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE MAN UAL MATCH  EFT-ERA",4 2)
  700  
  701   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE MAR K 0-BAL EF T MATCHED" ,43)
  702  
  703   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE MAR KED AUTO-P OST REPORT ",1)
  704  
  705   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE MAT CH EFT TO  ERA",41)
  706  
  707   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE PAR AMETER AUD IT REPORT" ,36)
  708  
  709   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE PAY ER EXCLUSI ON NAME TI N",14)
  710  
  711   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE PAY ER IDENTIF Y",50)
  712  
  713   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE PRO VIDER LVL  ADJ REPORT ",17)
  714  
  715   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE REM OVE DUP DE POSITS",47 )
  716  
  717   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE REM OVE ERA FR OM WORKLIS T",46)
  718  
  719   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE REM OVED ERA A UDIT",8)
  720  
  721   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE SIT E PARAMETE R REPORT", 35)
  722  
  723   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE UNA PPLIED EFT  DEP REPOR T",21)
  724  
  725   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE UNM ATCH ERA", 45)
  726  
  727   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE UNP OSTED EFT  OVERRIDE", 48)
  728  
  729   "BLD",1060 1,"KRN",19 ,"NM","B", "RCDPE VIE W/PRINT ER A",6)
  730  
  731   "BLD",1060 1,"KRN",19 .1,0)
  732   19.1
  733   "BLD",1060 1,"KRN",19 .1,"NM",0)
  734   ^9.68A^^
  735   "BLD",1060 1,"KRN",10 1,0)
  736   101
  737   "BLD",1060 1,"KRN",10 1,"NM",0)
  738   ^9.68A^19^ 19
  739   "BLD",1060 1,"KRN",10 1,"NM",1,0 )
  740   RCDPEX DUP  EXCEPTION  MENU^^0
  741   "BLD",1060 1,"KRN",10 1,"NM",2,0 )
  742   RCDPEX DEL ETE DUP ME SSAGE^^0
  743   "BLD",1060 1,"KRN",10 1,"NM",3,0 )
  744   RCDPEX FIL E DUPLICAT E MESSAGE^ ^0
  745   "BLD",1060 1,"KRN",10 1,"NM",4,0 )
  746   RCDPEX VIE W/PRINT DU P MESSAGE^ ^0
  747   "BLD",1060 1,"KRN",10 1,"NM",5,0 )
  748   RCDPE EFT  ERA MANUAL  MATCH^^0
  749   "BLD",1060 1,"KRN",10 1,"NM",6,0 )
  750   RCDPE EFT  PARTIAL MA TCH MENU^^ 0
  751   "BLD",1060 1,"KRN",10 1,"NM",7,0 )
  752   RCDPE EFT  PARTIAL MA TCH SELECT ^^0
  753   "BLD",1060 1,"KRN",10 1,"NM",8,0 )
  754   VALM QUIT^ ^0
  755   "BLD",1060 1,"KRN",10 1,"NM",9,0 )
  756   RCDPE EOB  WORKLIST A DMIN COST  ADJ^^0
  757   "BLD",1060 1,"KRN",10 1,"NM",10, 0)
  758   RCDPE APAR  SELECTED  EEOB MENU^ ^0
  759   "BLD",1060 1,"KRN",10 1,"NM",11, 0)
  760   RCDPE APAR  EEOB REFR ESH^^0
  761   "BLD",1060 1,"KRN",10 1,"NM",12, 0)
  762   RCDPE MARK  FOR AUTOP OST^^4^
  763   "BLD",1060 1,"KRN",10 1,"NM",13, 0)
  764   RCDPE APAR  VIEW/PRIN T ERA^^4^
  765   "BLD",1060 1,"KRN",10 1,"NM",14, 0)
  766   RCDPE APAR  SPLIT LIN E^^4^
  767   "BLD",1060 1,"KRN",10 1,"NM",15, 0)
  768   RCDPE APAR  VIEW/PRIN T EOB^^4^
  769   "BLD",1060 1,"KRN",10 1,"NM",16, 0)
  770   RCDPE APAR  RESEARCH^ ^4^
  771   "BLD",1060 1,"KRN",10 1,"NM",17, 0)
  772   RCDPE APAR  VERIFY^^4 ^
  773   "BLD",1060 1,"KRN",10 1,"NM",18, 0)
  774   VALM BLANK  1^^4^
  775   "BLD",1060 1,"KRN",10 1,"NM",19, 0)
  776   RCDPE APAR  CLAIM COM MENT^^4^
  777   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR CLAIM C OMMENT",19 )
  778  
  779   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR EEOB RE FRESH",11)
  780  
  781   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR RESEARC H",16)
  782  
  783   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR SELECTE D EEOB MEN U",10)
  784  
  785   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR SPLIT L INE",14)
  786  
  787   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR VERIFY" ,17)
  788  
  789   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR VIEW/PR INT EOB",1 5)
  790  
  791   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE AP AR VIEW/PR INT ERA",1 3)
  792  
  793   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE EF T ERA MANU AL MATCH", 5)
  794  
  795   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE EF T PARTIAL  MATCH MENU ",6)
  796  
  797   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE EF T PARTIAL  MATCH SELE CT",7)
  798  
  799   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE EO B WORKLIST  ADMIN COS T ADJ",9)
  800  
  801   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPE MA RK FOR AUT OPOST",12)
  802  
  803   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPEX D ELETE DUP  MESSAGE",2 )
  804  
  805   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPEX D UP EXCEPTI ON MENU",1 )
  806  
  807   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPEX F ILE DUPLIC ATE MESSAG E",3)
  808  
  809   "BLD",1060 1,"KRN",10 1,"NM","B" ,"RCDPEX V IEW/PRINT  DUP MESSAG E",4)
  810  
  811   "BLD",1060 1,"KRN",10 1,"NM","B" ,"VALM BLA NK 1",18)
  812  
  813   "BLD",1060 1,"KRN",10 1,"NM","B" ,"VALM QUI T",8)
  814  
  815   "BLD",1060 1,"KRN",40 9.61,0)
  816   409.61
  817   "BLD",1060 1,"KRN",40 9.61,"NM", 0)
  818   ^9.68A^5^5
  819   "BLD",1060 1,"KRN",40 9.61,"NM", 1,0)
  820   RCDPEX DUP LICATE ERA  LIST^^0
  821   "BLD",1060 1,"KRN",40 9.61,"NM", 2,0)
  822   RCDP LIST  OF RECEIPT S REPORT^^ 0
  823   "BLD",1060 1,"KRN",40 9.61,"NM", 3,0)
  824   RCDPE EEOB  MARKED FO R AP AUDIT ^^0
  825   "BLD",1060 1,"KRN",40 9.61,"NM", 4,0)
  826   RCDPE EFT  PARTIAL MA TCH^^0
  827   "BLD",1060 1,"KRN",40 9.61,"NM", 5,0)
  828   RCDPE VIEW  ERA DETAI L^^0
  829   "BLD",1060 1,"KRN",40 9.61,"NM", "B","RCDP  LIST OF RE CEIPTS REP ORT",2)
  830  
  831   "BLD",1060 1,"KRN",40 9.61,"NM", "B","RCDPE  EEOB MARK ED FOR AP  AUDIT",3)
  832  
  833   "BLD",1060 1,"KRN",40 9.61,"NM", "B","RCDPE  EFT PARTI AL MATCH", 4)
  834  
  835   "BLD",1060 1,"KRN",40 9.61,"NM", "B","RCDPE  VIEW ERA  DETAIL",5)
  836  
  837   "BLD",1060 1,"KRN",40 9.61,"NM", "B","RCDPE X DUPLICAT E ERA LIST ",1)
  838  
  839   "BLD",1060 1,"KRN",77 1,0)
  840   771
  841   "BLD",1060 1,"KRN",77 9.2,0)
  842   779.2
  843   "BLD",1060 1,"KRN",87 0,0)
  844   870
  845   "BLD",1060 1,"KRN",89 89.51,0)
  846   8989.51
  847   "BLD",1060 1,"KRN",89 89.52,0)
  848   8989.52
  849   "BLD",1060 1,"KRN",89 94,0)
  850   8994
  851   "BLD",1060 1,"KRN","B ",.4,.4)
  852  
  853   "BLD",1060 1,"KRN","B ",.401,.40 1)
  854  
  855   "BLD",1060 1,"KRN","B ",.402,.40 2)
  856  
  857   "BLD",1060 1,"KRN","B ",.403,.40 3)
  858  
  859   "BLD",1060 1,"KRN","B ",.5,.5)
  860  
  861   "BLD",1060 1,"KRN","B ",.84,.84)
  862  
  863   "BLD",1060 1,"KRN","B ",3.6,3.6)
  864  
  865   "BLD",1060 1,"KRN","B ",3.8,3.8)
  866  
  867   "BLD",1060 1,"KRN","B ",9.2,9.2)
  868  
  869   "BLD",1060 1,"KRN","B ",9.8,9.8)
  870  
  871   "BLD",1060 1,"KRN","B ",19,19)
  872  
  873   "BLD",1060 1,"KRN","B ",19.1,19. 1)
  874  
  875   "BLD",1060 1,"KRN","B ",101,101)
  876  
  877   "BLD",1060 1,"KRN","B ",409.61,4 09.61)
  878  
  879   "BLD",1060 1,"KRN","B ",771,771)
  880  
  881   "BLD",1060 1,"KRN","B ",779.2,77 9.2)
  882  
  883   "BLD",1060 1,"KRN","B ",870,870)
  884  
  885   "BLD",1060 1,"KRN","B ",8989.51, 8989.51)
  886  
  887   "BLD",1060 1,"KRN","B ",8989.52, 8989.52)
  888  
  889   "BLD",1060 1,"KRN","B ",8994,899 4)
  890  
  891   "BLD",1060 1,"QDEF")
  892   ^^^^^^^^YE S
  893   "BLD",1060 1,"QUES",0 )
  894   ^9.62^^
  895   "BLD",1060 1,"REQB",0 )
  896   ^9.611^4^3
  897   "BLD",1060 1,"REQB",1 ,0)
  898   PRCA*4.5*3 26^1
  899   "BLD",1060 1,"REQB",3 ,0)
  900   PRCA*4.5*3 19^1
  901   "BLD",1060 1,"REQB",4 ,0)
  902   PRCA*4.5*3 15^1
  903   "BLD",1060 1,"REQB"," B","PRCA*4 .5*315",4)
  904  
  905   "BLD",1060 1,"REQB"," B","PRCA*4 .5*319",3)
  906  
  907   "BLD",1060 1,"REQB"," B","PRCA*4 .5*326",1)
  908  
  909   "FIA",342)
  910   AR SITE PA RAMETER
  911   "FIA",342, 0)
  912   ^RC(342,
  913   "FIA",342, 0,0)
  914   342P
  915   "FIA",342, 0,1)
  916   y^y^p^^^^n ^^n
  917   "FIA",342, 0,10)
  918  
  919   "FIA",342, 0,11)
  920  
  921   "FIA",342, 0,"RLRO")
  922  
  923   "FIA",342, 0,"VR")
  924   4.5^PRCA
  925   "FIA",342, 342)
  926   1
  927   "FIA",342, 342,7.09)
  928  
  929   "FIA",344. 5)
  930   AR EDI LOC KBOX MESSA GES
  931   "FIA",344. 5,0)
  932   ^RCY(344.5 ,
  933   "FIA",344. 5,0,0)
  934   344.5
  935   "FIA",344. 5,0,1)
  936   y^y^p^^^^n ^^n
  937   "FIA",344. 5,0,10)
  938  
  939   "FIA",344. 5,0,11)
  940  
  941   "FIA",344. 5,0,"RLRO" )
  942  
  943   "FIA",344. 5,0,"VR")
  944   4.5^PRCA
  945   "FIA",344. 5,344.5)
  946   1
  947   "FIA",344. 5,344.5,.1 5)
  948  
  949   "FIA",344. 61)
  950   RCDPE PARA METER
  951   "FIA",344. 61,0)
  952   ^RCY(344.6 1,
  953   "FIA",344. 61,0,0)
  954   344.61P
  955   "FIA",344. 61,0,1)
  956   y^n^p^^^^n ^^n
  957   "FIA",344. 61,0,10)
  958  
  959   "FIA",344. 61,0,11)
  960  
  961   "FIA",344. 61,0,"RLRO ")
  962  
  963   "FIA",344. 61,0,"VR")
  964   4.5^PRCA
  965   "FIA",344. 61,344.61)
  966   1
  967   "FIA",344. 61,344.61, .07)
  968  
  969   "FIA",344. 61,344.61, .13)
  970  
  971   "FIA",344. 61,344.61, 2)
  972  
  973   "FIA",344. 61,344.61, 26)
  974  
  975   "FIA",344. 61,344.61, 27)
  976  
  977   "FIA",344. 61,344.61, 28)
  978  
  979   "FIA",344. 61,344.611 )
  980   1
  981   "FIA",344. 61,344.611 ,.01)
  982  
  983   "FIA",344. 61,344.611 ,.02)
  984  
  985   "FIA",344. 61,344.611 ,1)
  986  
  987   "FIA",344. 61,344.611 ,2)
  988  
  989   "FIA",344. 61,344.611 ,3)
  990  
  991   "FIA",344. 61,344.611 ,4)
  992  
  993   "INIT")
  994   POST^RCP33 2
  995   "IX",344.6 1,344.611, "ADU",0)
  996   344.611^AD U^By date  and user^R ^^R^IR^I^3 44.611^^^^ ^S
  997   "IX",344.6 1,344.611, "ADU",.1,0 )
  998   ^^2^2^3181 017^
  999   "IX",344.6 1,344.611, "ADU",.1,1 ,0)
  1000   This new s tyle cross  reference  by DATE a nd USER is  used to s ort the Au to 
  1001   "IX",344.6 1,344.611, "ADU",.1,2 ,0)
  1002   Parameter  History Re port.
  1003   "IX",344.6 1,344.611, "ADU",1)
  1004   S ^RCY(344 .61,DA(1), 2,"ADU",X( 1),X(2),DA )=""
  1005   "IX",344.6 1,344.611, "ADU",2)
  1006   K ^RCY(344 .61,DA(1), 2,"ADU",X( 1),X(2),DA )
  1007   "IX",344.6 1,344.611, "ADU",2.5)
  1008   K ^RCY(344 .61,DA(1), 2,"ADU")
  1009   "IX",344.6 1,344.611, "ADU",11.1 ,0)
  1010   ^.114IA^2^ 2
  1011   "IX",344.6 1,344.611, "ADU",11.1 ,1,0)
  1012   1^F^344.61 1^.01^^1^F
  1013   "IX",344.6 1,344.611, "ADU",11.1 ,2,0)
  1014   2^F^344.61 1^.02^^2^F
  1015   "IX",344.6 1,344.611, "ADU",11.1 ,2,2)
  1016   S X=$$GET1 ^DIQ(200,X _",",.01," E")
  1017   "KRN",19,4 294,-1)
  1018   4^30
  1019   "KRN",19,4 294,0)
  1020   PRCAF U AD MIN.RATE
  1021   "KRN",19,4 374,-1)
  1022   4^29
  1023   "KRN",19,4 374,0)
  1024   PRCA BIL A GENCY
  1025   "KRN",19,2 913281,-1)
  1026   0^27
  1027   "KRN",19,2 913281,0)
  1028   PRCA SITE  PARAMETER^ Site Param eter Edit^ ^M^^^^^^^^ ACCOUNTS R ECEIVABLE
  1029   "KRN",19,2 913281,1,0 )
  1030   ^19.06^4^4 ^3180731^^ ^^
  1031   "KRN",19,2 913281,1,1 ,0)
  1032   This optio n will all ow the AR  Supervisor  to edit t he site pa rameters
  1033   "KRN",19,2 913281,1,2 ,0)
  1034   for the AR  Package.   The site  parameters  allows th e system t o tailor
  1035   "KRN",19,2 913281,1,3 ,0)
  1036   itself for  specific  site needs , such as:  Number of  days to p urge
  1037   "KRN",19,2 913281,1,4 ,0)
  1038   Agent Cash ier Receip ts, When t o generate  IRS Offse t Letters,  etc.
  1039   "KRN",19,2 913281,10, 0)
  1040   ^19.01IP^1 3^13
  1041   "KRN",19,2 913281,10, 3,0)
  1042   2913286^^9 9
  1043   "KRN",19,2 913281,10, 3,"^")
  1044   PRCA NOTIF ICATION PA RAMETERS
  1045   "KRN",19,2 913281,10, 4,0)
  1046   4374^^40
  1047   "KRN",19,2 913281,10, 4,"^")
  1048   PRCA BIL A GENCY
  1049   "KRN",19,2 913281,10, 5,0)
  1050   4294^^45
  1051   "KRN",19,2 913281,10, 5,"^")
  1052   PRCAF U AD MIN.RATE
  1053   "KRN",19,2 913281,10, 6,0)
  1054   2914444^^1 0
  1055   "KRN",19,2 913281,10, 6,"^")
  1056   PRCA DEACT IVATE GROU P
  1057   "KRN",19,2 913281,10, 7,0)
  1058   2917347^^9 0
  1059   "KRN",19,2 913281,10, 7,"^")
  1060   PRCA RC PA RAMETERS
  1061   "KRN",19,2 913281,10, 8,0)
  1062   2919459^^2 0
  1063   "KRN",19,2 913281,10, 8,"^")
  1064   RCDPE EDI  LOCKBOX PA RAMETERS
  1065   "KRN",19,2 913281,10, 9,0)
  1066   2919710^^5
  1067   "KRN",19,2 913281,10, 9,"^")
  1068   PRCA CBO P ARAMETERS
  1069   "KRN",19,2 913281,10, 10,0)
  1070   2922183^^3 0
  1071   "KRN",19,2 913281,10, 10,"^")
  1072   RCDPE SITE  PARAMETER  REPORT
  1073   "KRN",19,2 913281,10, 11,0)
  1074   2922184^^2 5
  1075   "KRN",19,2 913281,10, 11,"^")
  1076   RCDPE PARA METER AUDI T REPORT
  1077   "KRN",19,2 913281,10, 12,0)
  1078   2922185^^1 5
  1079   "KRN",19,2 913281,10, 12,"^")
  1080   RCDPE EXCL USION AUDI T REPORT
  1081   "KRN",19,2 913281,10, 13,0)
  1082   2922540^^3 5
  1083   "KRN",19,2 913281,10, 13,"^")
  1084   RCDPE AUTO  PARAM HIS T REPORT
  1085   "KRN",19,2 913281,99)
  1086   64866,4487 3
  1087   "KRN",19,2 913281,"U" )
  1088   SITE PARAM ETER EDIT
  1089   "KRN",19,2 913286,-1)
  1090   4^28
  1091   "KRN",19,2 913286,0)
  1092   PRCA NOTIF ICATION PA RAMETERS
  1093   "KRN",19,2 914444,-1)
  1094   4^31
  1095   "KRN",19,2 914444,0)
  1096   PRCA DEACT IVATE GROU P
  1097   "KRN",19,2 917347,-1)
  1098   4^32
  1099   "KRN",19,2 917347,0)
  1100   PRCA RC PA RAMETERS
  1101   "KRN",19,2 918319,-1)
  1102   0^52
  1103   "KRN",19,2 918319,0)
  1104   RCDP EXTEN DED CHECK/ CC SEARCH^ Extended C heck/Trace /Credit Ca rd Search^ ^R^^^^^^^^ ACCOUNTS R ECEIVABLE
  1105   "KRN",19,2 918319,1,0 )
  1106   ^19.06^2^2 ^3040302^^
  1107   "KRN",19,2 918319,1,1 ,0)
  1108   This optio n will sea rch all pa yments for  a check,  trace #, o r credit c ard
  1109   "KRN",19,2 918319,1,2 ,0)
  1110   number.
  1111   "KRN",19,2 918319,25)
  1112   RCDPRSEA
  1113   "KRN",19,2 918319,"U" )
  1114   EXTENDED C HECK/TRACE /CREDIT CA
  1115   "KRN",19,2 919459,-1)
  1116   4^33
  1117   "KRN",19,2 919459,0)
  1118   RCDPE EDI  LOCKBOX PA RAMETERS
  1119   "KRN",19,2 919461,-1)
  1120   4^40
  1121   "KRN",19,2 919461,0)
  1122   RCDPE EXCE PTION PROC ESSING
  1123   "KRN",19,2 919462,-1)
  1124   4^4
  1125   "KRN",19,2 919462,0)
  1126   RCDPE EFT  AGING REPO RT
  1127   "KRN",19,2 919463,-1)
  1128   4^5
  1129   "KRN",19,2 919463,0)
  1130   RCDPE ERA  AGING REPO RT
  1131   "KRN",19,2 919464,-1)
  1132   4^41
  1133   "KRN",19,2 919464,0)
  1134   RCDPE MATC H EFT TO E RA
  1135   "KRN",19,2 919465,-1)
  1136   4^39
  1137   "KRN",19,2 919465,0)
  1138   RCDPE EDI  LOCKBOX WO RKLIST
  1139   "KRN",19,2 919467,-1)
  1140   0^38
  1141   "KRN",19,2 919467,0)
  1142   RCDPE EDI  LOCKBOX ME NU^EDI Loc kbox (ePay ments)^^M^ ^^^^^^^ACC OUNTS RECE IVABLE
  1143   "KRN",19,2 919467,1,0 )
  1144   ^19.06^1^1 ^3180801^^ ^^
  1145   "KRN",19,2 919467,1,1 ,0)
  1146   This is th e menu tha t contains  the EDI L ockbox fun ctionality .
  1147   "KRN",19,2 919467,10, 0)
  1148   ^19.01IP^1 9^18
  1149   "KRN",19,2 919467,10, 2,0)
  1150   2919465^WL ^10
  1151   "KRN",19,2 919467,10, 2,"^")
  1152   RCDPE EDI  LOCKBOX WO RKLIST
  1153   "KRN",19,2 919467,10, 5,0)
  1154   2919461^EX C^5
  1155   "KRN",19,2 919467,10, 5,"^")
  1156   RCDPE EXCE PTION PROC ESSING
  1157   "KRN",19,2 919467,10, 6,0)
  1158   2919464^MA ^20
  1159   "KRN",19,2 919467,10, 6,"^")
  1160   RCDPE MATC H EFT TO E RA
  1161   "KRN",19,2 919467,10, 7,0)
  1162   2919470^RE P^55
  1163   "KRN",19,2 919467,10, 7,"^")
  1164   RCDPE EDI  LOCKBOX RE PORTS MENU
  1165   "KRN",19,2 919467,10, 8,0)
  1166   2919471^MM ^30
  1167   "KRN",19,2 919467,10, 8,"^")
  1168   RCDPE MANU AL MATCH E FT-ERA
  1169   "KRN",19,2 919467,10, 9,0)
  1170   2919472^ZB ^70
  1171   "KRN",19,2 919467,10, 9,"^")
  1172   RCDPE MARK  0-BAL EFT  MATCHED
  1173   "KRN",19,2 919467,10, 11,0)
  1174   2919476^UP ^65
  1175   "KRN",19,2 919467,10, 11,"^")
  1176   RCDPE ERA  POSTED BY  PAPER EOB
  1177   "KRN",19,2 919467,10, 12,0)
  1178   2919478^UN ^60
  1179   "KRN",19,2 919467,10, 12,"^")
  1180   RCDPE UNMA TCH ERA
  1181   "KRN",19,2 919467,10, 13,0)
  1182   2921657^RE M^50
  1183   "KRN",19,2 919467,10, 13,"^")
  1184   RCDPE REMO VE ERA FRO M WORKLIST
  1185   "KRN",19,2 919467,10, 14,0)
  1186   2922178^MC R^25
  1187   "KRN",19,2 919467,10, 14,"^")
  1188   RCDPE EEOB  MOVE/COPY /REMOVE
  1189   "KRN",19,2 919467,10, 15,0)
  1190   2921609^RE FT^45
  1191   "KRN",19,2 919467,10, 15,"^")
  1192   RCDPE REMO VE DUP DEP OSITS
  1193   "KRN",19,2 919467,10, 16,0)
  1194   2922187^OE FT^40
  1195   "KRN",19,2 919467,10, 16,"^")
  1196   RCDPE UNPO STED EFT O VERRIDE
  1197   "KRN",19,2 919467,10, 17,0)
  1198   2922188^AP AR^15
  1199   "KRN",19,2 919467,10, 17,"^")
  1200   RCDPE APAR
  1201   "KRN",19,2 919467,10, 18,0)
  1202   2922466^ID P^80
  1203   "KRN",19,2 919467,10, 18,"^")
  1204   RCDPE PAYE R IDENTIFY
  1205   "KRN",19,2 919467,10, 19,0)
  1206   2922539^DU P^42
  1207   "KRN",19,2 919467,10, 19,"^")
  1208   RCDPE DUPL ICATE ERA  WORKLIST
  1209   "KRN",19,2 919467,10. 1)
  1210  
  1211   "KRN",19,2 919467,99)
  1212   64915,5123 0
  1213   "KRN",19,2 919467,99. 1)
  1214   64961,3401 3
  1215   "KRN",19,2 919467,"U" )
  1216   EDI LOCKBO X (EPAYMEN TS)
  1217   "KRN",19,2 919468,-1)
  1218   4^3
  1219   "KRN",19,2 919468,0)
  1220   RCDPE EDI  LOCKBOX AC T REPORT
  1221   "KRN",19,2 919470,-1)
  1222   0^2
  1223   "KRN",19,2 919470,0)
  1224   RCDPE EDI  LOCKBOX RE PORTS MENU ^EDI Lockb ox (ePayme nts) Repor ts Menu^^M ^^^^^^^^AC COUNTS REC EIVABLE
  1225   "KRN",19,2 919470,1,0 )
  1226   2^19.06^2^ 2^3181105^ ^^^
  1227   "KRN",19,2 919470,1,1 ,0)
  1228   This menu  allows acc ess to all  the repor ts that ca n be produ ced for ED I
  1229   "KRN",19,2 919470,1,2 ,0)
  1230   Lockbox.
  1231   "KRN",19,2 919470,10, 0)
  1232   ^19.01IP^3 1^8
  1233   "KRN",19,2 919470,10, 6,0)
  1234   2919477^VP ^25
  1235   "KRN",19,2 919470,10, 6,"^")
  1236   RCDPE VIEW /PRINT ERA
  1237   "KRN",19,2 919470,10, 28,0)
  1238   2922545^AU DR^20
  1239   "KRN",19,2 919470,10, 28,"^")
  1240   RCDPE EDI  LOCKBOX AU DIT RPRTS
  1241   "KRN",19,2 919470,10, 29,0)
  1242   2922548^WO RK^5
  1243   "KRN",19,2 919470,10, 29,"^")
  1244   RCDPE EDI  LOCKBOX WO RKLD RPRTS
  1245   "KRN",19,2 919470,10, 30,0)
  1246   2922546^RE SR^15
  1247   "KRN",19,2 919470,10, 30,"^")
  1248   RCDPE EDI  LOCKBOX AR SRCH RPRTS
  1249   "KRN",19,2 919470,10, 31,0)
  1250   2922547^AD JR^10
  1251   "KRN",19,2 919470,10, 31,"^")
  1252   RCDPE EDI  LOCKBOX AD JCDE RPRTS
  1253   "KRN",19,2 919470,99)
  1254   64960,3835 3
  1255   "KRN",19,2 919470,99. 1)
  1256   59232,4962 9
  1257   "KRN",19,2 919470,"U" )
  1258   EDI LOCKBO X (EPAYMEN TS) REPORT
  1259   "KRN",19,2 919471,-1)
  1260   0^42
  1261   "KRN",19,2 919471,0)
  1262   RCDPE MANU AL MATCH E FT-ERA^EFT  Manual Ma tch^^R^^^^ ^^^^ACCOUN TS RECEIVA BLE
  1263   "KRN",19,2 919471,1,0 )
  1264   ^19.06^5^5 ^3030512^^ ^^
  1265   "KRN",19,2 919471,1,1 ,0)
  1266   This optio n will all ow the use r to choos e an EFT d etail reco rd and an  ERA
  1267   "KRN",19,2 919471,1,2 ,0)
  1268   record and  will mark  the 2 rec ords as ma tched.  Th is should  be used on ly
  1269   "KRN",19,2 919471,1,3 ,0)
  1270   if the aut omatic mat ching func tion is no t able to  make the m atch. The
  1271   "KRN",19,2 919471,1,4 ,0)
  1272   EFT and ER A selected  must both  be unmatc hed and th e ERA must  not be
  1273   "KRN",19,2 919471,1,5 ,0)
  1274   associated  with a re ceipt.
  1275   "KRN",19,2 919471,25)
  1276   MATCH1^RCD PEM2
  1277   "KRN",19,2 919471,"U" )
  1278   EFT MANUAL  MATCH
  1279   "KRN",19,2 919472,-1)
  1280   4^43
  1281   "KRN",19,2 919472,0)
  1282   RCDPE MARK  0-BAL EFT  MATCHED
  1283   "KRN",19,2 919476,-1)
  1284   4^44
  1285   "KRN",19,2 919476,0)
  1286   RCDPE ERA  POSTED BY  PAPER EOB
  1287   "KRN",19,2 919477,-1)
  1288   4^6
  1289   "KRN",19,2 919477,0)
  1290   RCDPE VIEW /PRINT ERA
  1291   "KRN",19,2 919478,-1)
  1292   4^45
  1293   "KRN",19,2 919478,0)
  1294   RCDPE UNMA TCH ERA
  1295   "KRN",19,2 919710,-1)
  1296   4^34
  1297   "KRN",19,2 919710,0)
  1298   PRCA CBO P ARAMETERS
  1299   "KRN",19,2 919712,-1)
  1300   4^7
  1301   "KRN",19,2 919712,0)
  1302   RCDPE ACTI VE WITH EE OB REPORT
  1303   "KRN",19,2 921609,-1)
  1304   4^47
  1305   "KRN",19,2 921609,0)
  1306   RCDPE REMO VE DUP DEP OSITS
  1307   "KRN",19,2 921610,-1)
  1308   4^9
  1309   "KRN",19,2 921610,0)
  1310   RCDPE ERA  W/PAPER EO B REPORT
  1311   "KRN",19,2 921611,-1)
  1312   4^10
  1313   "KRN",19,2 921611,0)
  1314   RCDPE EFT  AUDIT REPO RT
  1315   "KRN",19,2 921657,-1)
  1316   4^46
  1317   "KRN",19,2 921657,0)
  1318   RCDPE REMO VE ERA FRO M WORKLIST
  1319   "KRN",19,2 921658,-1)
  1320   4^8
  1321   "KRN",19,2 921658,0)
  1322   RCDPE REMO VED ERA AU DIT
  1323   "KRN",19,2 922178,-1)
  1324   4^51
  1325   "KRN",19,2 922178,0)
  1326   RCDPE EEOB  MOVE/COPY /REMOVE
  1327   "KRN",19,2 922179,-1)
  1328   4^11
  1329   "KRN",19,2 922179,0)
  1330   RCDPE EEOB  MOVE/COPY /RMOVE RPT
  1331   "KRN",19,2 922181,-1)
  1332   4^12
  1333   "KRN",19,2 922181,0)
  1334   RCDPE AUTO -POST REPO RT
  1335   "KRN",19,2 922182,-1)
  1336   4^13
  1337   "KRN",19,2 922182,0)
  1338   RCDPE AUTO -DECREASE  REPORT
  1339   "KRN",19,2 922183,-1)
  1340   4^35
  1341   "KRN",19,2 922183,0)
  1342   RCDPE SITE  PARAMETER  REPORT
  1343   "KRN",19,2 922184,-1)
  1344   4^36
  1345   "KRN",19,2 922184,0)
  1346   RCDPE PARA METER AUDI T REPORT
  1347   "KRN",19,2 922185,-1)
  1348   4^37
  1349   "KRN",19,2 922185,0)
  1350   RCDPE EXCL USION AUDI T REPORT
  1351   "KRN",19,2 922186,-1)
  1352   4^14
  1353   "KRN",19,2 922186,0)
  1354   RCDPE PAYE R EXCLUSIO N NAME TIN
  1355   "KRN",19,2 922187,-1)
  1356   4^48
  1357   "KRN",19,2 922187,0)
  1358   RCDPE UNPO STED EFT O VERRIDE
  1359   "KRN",19,2 922188,-1)
  1360   4^49
  1361   "KRN",19,2 922188,0)
  1362   RCDPE APAR
  1363   "KRN",19,2 922295,-1)
  1364   4^19
  1365   "KRN",19,2 922295,0)
  1366   RCDPE CARC  CODE PAYE R REPORT
  1367   "KRN",19,2 922296,-1)
  1368   4^15
  1369   "KRN",19,2 922296,0)
  1370   RCDPE CARC /RARC TABL E REPORT
  1371   "KRN",19,2 922297,-1)
  1372   4^17
  1373   "KRN",19,2 922297,0)
  1374   RCDPE PROV IDER LVL A DJ REPORT
  1375   "KRN",19,2 922298,-1)
  1376   4^18
  1377   "KRN",19,2 922298,0)
  1378   RCDPE EFT  TRANSACTIO N AUD REP
  1379   "KRN",19,2 922299,-1)
  1380   4^16
  1381   "KRN",19,2 922299,0)
  1382   RCDPE CARC /RARC QUIC K SEARCH
  1383   "KRN",19,2 922302,-1)
  1384   4^24
  1385   "KRN",19,2 922302,0)
  1386   RCDPE EFT- ERA TRENDI NG REPORT
  1387   "KRN",19,2 922310,-1)
  1388   4^20
  1389   "KRN",19,2 922310,0)
  1390   RCDPE ERA  STATUS CHN G AUD REP
  1391   "KRN",19,2 922424,-1)
  1392   4^21
  1393   "KRN",19,2 922424,0)
  1394   RCDPE UNAP PLIED EFT  DEP REPORT
  1395   "KRN",19,2 922446,-1)
  1396   4^22
  1397   "KRN",19,2 922446,0)
  1398   RCDPE AUTO -POST RECE IPT REPORT
  1399   "KRN",19,2 922466,-1)
  1400   4^50
  1401   "KRN",19,2 922466,0)
  1402   RCDPE PAYE R IDENTIFY
  1403   "KRN",19,2 922537,-1)
  1404   0^1
  1405   "KRN",19,2 922537,0)
  1406   RCDPE MARK ED AUTO-PO ST REPORT^ EEOBs Mark ed for Aut o-Post Aud it Report^ ^R^^^^^^^^ ACCOUNTS R ECEIVABLE
  1407   "KRN",19,2 922537,1,0 )
  1408   ^^3^3^3180 705^
  1409   "KRN",19,2 922537,1,1 ,0)
  1410   The marked  for autop ost audit  report wil l list the  user who  marked an  EEOB
  1411   "KRN",19,2 922537,1,2 ,0)
  1412   for autopo st. Lines  included i n the repo rt are bas ed on filt er criteri
  1413   "KRN",19,2 922537,1,3 ,0)
  1414   selected a t run time  by the en d user.
  1415   "KRN",19,2 922537,25)
  1416   EN^RCDPEMA P
  1417   "KRN",19,2 922537,"U" )
  1418   EEOBS MARK ED FOR AUT O-POST AUD
  1419   "KRN",19,2 922538,-1)
  1420   0^23
  1421   "KRN",19,2 922538,0)
  1422   RCDPE EFT  OVERRIDE R EPORT^Pend ing EFT Ov erride Rep ort^^R^^^^ ^^^^
  1423   "KRN",19,2 922538,1,0 )
  1424   ^^3^3^3180 710^
  1425   "KRN",19,2 922538,1,1 ,0)
  1426   This repor t allows l isting by  date range  of unpost ed medical
  1427   "KRN",19,2 922538,1,2 ,0)
  1428   EFTs that  are older  than the l imit set i n the NUMB ER OF DAYS  (AGE) OF  UNPOSTED
  1429   "KRN",19,2 922538,1,3 ,0)
  1430   MEDICAL EF TS TO PREV ENT POSTIN G paramete r.
  1431   "KRN",19,2 922538,25)
  1432   EN^RCDPEFT L
  1433   "KRN",19,2 922538,"U" )
  1434   PENDING EF T OVERRIDE  REPORT
  1435   "KRN",19,2 922539,-1)
  1436   0^25
  1437   "KRN",19,2 922539,0)
  1438   RCDPE DUPL ICATE ERA  WORKLIST^D uplicate E RA Worklis t^^A^^^^^^ ^^^^1
  1439   "KRN",19,2 922539,1,0 )
  1440   ^^2^2^3180 730^
  1441   "KRN",19,2 922539,1,1 ,0)
  1442   Used for t he Duplica te ERA Wor klist
  1443   "KRN",19,2 922539,1,2 ,0)
  1444   See ListMa n template : RCDPEX D UPLICATE E RA LIST
  1445   "KRN",19,2 922539,20)
  1446   D EN1^RCDP EX1
  1447   "KRN",19,2 922539,"U" )
  1448   DUPLICATE  ERA WORKLI ST
  1449   "KRN",19,2 922540,-1)
  1450   0^26
  1451   "KRN",19,2 922540,0)
  1452   RCDPE AUTO  PARAM HIS T REPORT^A uto Parame ter Histor y Report^^ R^^^^^^^^A CCOUNTS RE CEIVABLE
  1453   "KRN",19,2 922540,25)
  1454   EN^RCDPESP 8
  1455   "KRN",19,2 922540,"U" )
  1456   AUTO PARAM ETER HISTO RY REPORT
  1457   "KRN",19,2 922545,-1)
  1458   0^55
  1459   "KRN",19,2 922545,0)
  1460   RCDPE EDI  LOCKBOX AU DIT RPRTS^ Audit Repo rts^^M^^^^ ^^^^ACCOUN TS RECEIVA BLE
  1461   "KRN",19,2 922545,1,0 )
  1462   ^19.06^2^2 ^3181106^^ ^^
  1463   "KRN",19,2 922545,1,1 ,0)
  1464   This menu  holds the  Accounts R eceivable  /ePayments  
  1465   "KRN",19,2 922545,1,2 ,0)
  1466   reports re lated to a uditing.
  1467   "KRN",19,2 922545,10, 0)
  1468   ^19.01IP^1 2^12
  1469   "KRN",19,2 922545,10, 1,0)
  1470   2922182^AD ^26
  1471   "KRN",19,2 922545,10, 1,"^")
  1472   RCDPE AUTO -DECREASE  REPORT
  1473   "KRN",19,2 922545,10, 2,0)
  1474   2922181^AP ^32
  1475   "KRN",19,2 922545,10, 2,"^")
  1476   RCDPE AUTO -POST REPO RT
  1477   "KRN",19,2 922545,10, 3,0)
  1478   2922446^AP R^36
  1479   "KRN",19,2 922545,10, 3,"^")
  1480   RCDPE AUTO -POST RECE IPT REPORT
  1481   "KRN",19,2 922545,10, 4,0)
  1482   2921611^DU PR^48
  1483   "KRN",19,2 922545,10, 4,"^")
  1484   RCDPE EFT  AUDIT REPO RT
  1485   "KRN",19,2 922545,10, 5,0)
  1486   2922310^ES C^52
  1487   "KRN",19,2 922545,10, 5,"^")
  1488   RCDPE ERA  STATUS CHN G AUD REP
  1489   "KRN",19,2 922545,10, 6,0)
  1490   2922298^ET A^56
  1491   "KRN",19,2 922545,10, 6,"^")
  1492   RCDPE EFT  TRANSACTIO N AUD REP
  1493   "KRN",19,2 922545,10, 7,0)
  1494   2922179^MC R^60
  1495   "KRN",19,2 922545,10, 7,"^")
  1496   RCDPE EEOB  MOVE/COPY /RMOVE RPT
  1497   "KRN",19,2 922545,10, 8,0)
  1498   2922537^EM A^64
  1499   "KRN",19,2 922545,10, 8,"^")
  1500   RCDPE MARK ED AUTO-PO ST REPORT
  1501   "KRN",19,2 922545,10, 9,0)
  1502   2921610^PO SR^72
  1503   "KRN",19,2 922545,10, 9,"^")
  1504   RCDPE ERA  W/PAPER EO B REPORT
  1505   "KRN",19,2 922545,10, 10,0)
  1506   2922186^PX ^76
  1507   "KRN",19,2 922545,10, 10,"^")
  1508   RCDPE PAYE R EXCLUSIO N NAME TIN
  1509   "KRN",19,2 922545,10, 11,0)
  1510   2921658^RE MR^84
  1511   "KRN",19,2 922545,10, 11,"^")
  1512   RCDPE REMO VED ERA AU DIT
  1513   "KRN",19,2 922545,10, 12,0)
  1514   2922540^AP H^40
  1515   "KRN",19,2 922545,10, 12,"^")
  1516   RCDPE AUTO  PARAM HIS T REPORT
  1517   "KRN",19,2 922545,99)
  1518   64961,3391 5
  1519   "KRN",19,2 922545,"U" )
  1520   AUDIT REPO RTS
  1521   "KRN",19,2 922546,-1)
  1522   0^53
  1523   "KRN",19,2 922546,0)
  1524   RCDPE EDI  LOCKBOX AR SRCH RPRTS ^Additiona l Research  Reports^^ M^^^^^^^^A CCOUNTS RE CEIVABLE
  1525   "KRN",19,2 922546,1,0 )
  1526   ^19.06^2^2 ^3181105^^
  1527   "KRN",19,2 922546,1,1 ,0)
  1528   This menu  holds the  Accounts R eceivable  /ePayments  
  1529   "KRN",19,2 922546,1,2 ,0)
  1530   Additional  Research  reports.
  1531   "KRN",19,2 922546,10, 0)
  1532   ^19.01IP^2 ^2
  1533   "KRN",19,2 922546,10, 1,0)
  1534   2922302^ET R^20
  1535   "KRN",19,2 922546,10, 1,"^")
  1536   RCDPE EFT- ERA TRENDI NG REPORT
  1537   "KRN",19,2 922546,10, 2,0)
  1538   2919712^AB ^28
  1539   "KRN",19,2 922546,10, 2,"^")
  1540   RCDPE ACTI VE WITH EE OB REPORT
  1541   "KRN",19,2 922546,99)
  1542   64957,6909 1
  1543   "KRN",19,2 922546,"U" )
  1544   ADDITIONAL  RESEARCH  REPORTS
  1545   "KRN",19,2 922547,-1)
  1546   0^54
  1547   "KRN",19,2 922547,0)
  1548   RCDPE EDI  LOCKBOX AD JCDE RPRTS ^Adjustmen t Code Rep orts^^M^^^ ^^^^^ACCOU NTS RECEIV ABLE
  1549   "KRN",19,2 922547,1,0 )
  1550   ^19.06^2^2 ^3181105^^
  1551   "KRN",19,2 922547,1,1 ,0)
  1552   This menu  holds the  Accounts R eceivable  /ePayments  
  1553   "KRN",19,2 922547,1,2 ,0)
  1554   Adjustment  Code repo rts.
  1555   "KRN",19,2 922547,10, 0)
  1556   ^19.01IP^4 ^4
  1557   "KRN",19,2 922547,10, 1,0)
  1558   2922295^CR ^44
  1559   "KRN",19,2 922547,10, 1,"^")
  1560   RCDPE CARC  CODE PAYE R REPORT
  1561   "KRN",19,2 922547,10, 2,0)
  1562   2922297^PL B^68
  1563   "KRN",19,2 922547,10, 2,"^")
  1564   RCDPE PROV IDER LVL A DJ REPORT
  1565   "KRN",19,2 922547,10, 3,0)
  1566   2922299^QS ^80
  1567   "KRN",19,2 922547,10, 3,"^")
  1568   RCDPE CARC /RARC QUIC K SEARCH
  1569   "KRN",19,2 922547,10, 4,0)
  1570   2922296^TB ^88
  1571   "KRN",19,2 922547,10, 4,"^")
  1572   RCDPE CARC /RARC TABL E REPORT
  1573   "KRN",19,2 922547,99)
  1574   64957,6936 8
  1575   "KRN",19,2 922547,"U" )
  1576   ADJUSTMENT  CODE REPO RTS
  1577   "KRN",19,2 922548,-1)
  1578   0^56
  1579   "KRN",19,2 922548,0)
  1580   RCDPE EDI  LOCKBOX WO RKLD RPRTS ^Workload  Reports^^M ^^^^^^^^AC COUNTS REC EIVABLE
  1581   "KRN",19,2 922548,1,0 )
  1582   ^19.06^1^1 ^3181105^^ ^
  1583   "KRN",19,2 922548,1,1 ,0)
  1584   This menu  holds the  Accounts R eceivable  /ePayments  Workload  reports.
  1585   "KRN",19,2 922548,10, 0)
  1586   ^19.01IP^5 ^5
  1587   "KRN",19,2 922548,10, 1,0)
  1588   2919468^DA ^4
  1589   "KRN",19,2 922548,10, 1,"^")
  1590   RCDPE EDI  LOCKBOX AC T REPORT
  1591   "KRN",19,2 922548,10, 2,0)
  1592   2919462^EF T^8
  1593   "KRN",19,2 922548,10, 2,"^")
  1594   RCDPE EFT  AGING REPO RT
  1595   "KRN",19,2 922548,10, 3,0)
  1596   2919463^ER A^12
  1597   "KRN",19,2 922548,10, 3,"^")
  1598   RCDPE ERA  AGING REPO RT
  1599   "KRN",19,2 922548,10, 4,0)
  1600   2922538^PE O^16
  1601   "KRN",19,2 922548,10, 4,"^")
  1602   RCDPE EFT  OVERRIDE R EPORT
  1603   "KRN",19,2 922548,10, 5,0)
  1604   2922424^UN ^24
  1605   "KRN",19,2 922548,10, 5,"^")
  1606   RCDPE UNAP PLIED EFT  DEP REPORT
  1607   "KRN",19,2 922548,99)
  1608   64957,6813 9
  1609   "KRN",19,2 922548,"U" )
  1610   WORKLOAD R EPORTS
  1611   "KRN",101, 1697,-1)
  1612   0^8
  1613   "KRN",101, 1697,0)
  1614   VALM QUIT^ Quit^^A^^^ ^^^^^
  1615   "KRN",101, 1697,.1)
  1616    
  1617   "KRN",101, 1697,1,0)
  1618   ^^1^1^2911 105^
  1619   "KRN",101, 1697,1,1,0 )
  1620   This proto col can be  used as a  generic ' quit' acti on.
  1621   "KRN",101, 1697,2,0)
  1622   ^101.02A^2 ^2
  1623   "KRN",101, 1697,2,1,0 )
  1624   EXIT
  1625   "KRN",101, 1697,2,2,0 )
  1626   QUIT
  1627   "KRN",101, 1697,2,"B" ,"EXIT",1)
  1628  
  1629   "KRN",101, 1697,2,"B" ,"QUIT",2)
  1630  
  1631   "KRN",101, 1697,15)
  1632  
  1633   "KRN",101, 1697,20)
  1634   Q
  1635   "KRN",101, 1697,99)
  1636   63700,2855 7
  1637   "KRN",101, 1702,-1)
  1638   4^18
  1639   "KRN",101, 1702,0)
  1640   VALM BLANK  1
  1641   "KRN",101, 7602,-1)
  1642   0^9
  1643   "KRN",101, 7602,0)
  1644   RCDPE EOB  WORKLIST A DMIN COST  ADJ^Admin  Cost Adj^^ A^^^^^^^^A CCOUNTS RE CEIVABLE
  1645   "KRN",101, 7602,1,0)
  1646   ^101.06^1^ 1^3170327^ ^^
  1647   "KRN",101, 7602,1,1,0 )
  1648   Used to ad just the a dministrat ive costs,  IRS cost,  DMV cost,  etc
  1649   "KRN",101, 7602,15)
  1650   S VALMBCK= "R" K PRCA SUP
  1651   "KRN",101, 7602,20)
  1652   S PRCASUP= 1 D FULL^V ALM1 D EN1 ^PRCAEXM(1 ) K DTOUT
  1653   "KRN",101, 7602,99)
  1654   63700,2855 7
  1655   "KRN",101, 7963,-1)
  1656   4^13
  1657   "KRN",101, 7963,0)
  1658   RCDPE APAR  VIEW/PRIN T ERA
  1659   "KRN",101, 7965,-1)
  1660   0^10
  1661   "KRN",101, 7965,0)
  1662   RCDPE APAR  SELECTED  EEOB MENU^ APAR Selec ted EEOB^^ M^^^^^^^^A CCOUNTS RE CEIVABLE
  1663   "KRN",101, 7965,1,0)
  1664   ^101.06^3^ 3^3181004^ ^^^
  1665   "KRN",101, 7965,1,1,0 )
  1666   The APAR s elected EE OB menu co ntains the  actions t hat can be  performed  
  1667   "KRN",101, 7965,1,2,0 )
  1668   manually o n the EEOB  item that  did not g et a recei pt when th e associat ed 
  1669   "KRN",101, 7965,1,3,0 )
  1670   ERA record  was proce ssed durin g the auto -post nigh tly proces s.
  1671   "KRN",101, 7965,4)
  1672   25^4
  1673   "KRN",101, 7965,10,0)
  1674   ^101.01PA^ 21^20
  1675   "KRN",101, 7965,10,1, 0)
  1676   1697^^999^ ^^EXIT
  1677   "KRN",101, 7965,10,1, "^")
  1678   VALM QUIT
  1679   "KRN",101, 7965,10,3, 0)
  1680   7966^^100^
  1681   "KRN",101, 7965,10,3, "^")
  1682   RCDPE MARK  FOR AUTOP OST
  1683   "KRN",101, 7965,10,10 ,0)
  1684   7963^ERA^2 20^
  1685   "KRN",101, 7965,10,10 ,"^")
  1686   RCDPE APAR  VIEW/PRIN T ERA
  1687   "KRN",101, 7965,10,11 ,0)
  1688   7967^^50^
  1689   "KRN",101, 7965,10,11 ,"^")
  1690   RCDPE APAR  SPLIT LIN E
  1691   "KRN",101, 7965,10,13 ,0)
  1692   7969^^240^ ^^Research  Menu
  1693   "KRN",101, 7965,10,13 ,"^")
  1694   RCDPE APAR  RESEARCH
  1695   "KRN",101, 7965,10,14 ,0)
  1696   7968^^310^
  1697   "KRN",101, 7965,10,14 ,"^")
  1698   RCDPE APAR  EEOB REFR ESH
  1699   "KRN",101, 7965,10,15 ,0)
  1700   7971^EOB^2 10^
  1701   "KRN",101, 7965,10,15 ,"^")
  1702   RCDPE APAR  VIEW/PRIN T EOB
  1703   "KRN",101, 7965,10,16 ,0)
  1704   7973^^320^ ^^
  1705   "KRN",101, 7965,10,16 ,"^")
  1706   RCDPE APAR  VERIFY
  1707   "KRN",101, 7965,10,19 ,0)
  1708   1702^^250^
  1709   "KRN",101, 7965,10,19 ,"^")
  1710   VALM BLANK  1
  1711   "KRN",101, 7965,10,20 ,0)
  1712   8017^^150^
  1713   "KRN",101, 7965,10,20 ,"^")
  1714   RCDPE APAR  CLAIM COM MENT
  1715   "KRN",101, 7965,10,21 ,0)
  1716   1702^^170^
  1717   "KRN",101, 7965,10,21 ,"^")
  1718   VALM BLANK  1
  1719   "KRN",101, 7965,15)
  1720   I $G(RCFAS TXT) S VAL MBCK="Q"
  1721   "KRN",101, 7965,26)
  1722   D SHOW^VAL M
  1723   "KRN",101, 7965,28)
  1724   Select Act ion: 
  1725   "KRN",101, 7965,99)
  1726   64960,3137 1
  1727   "KRN",101, 7966,-1)
  1728   4^12
  1729   "KRN",101, 7966,0)
  1730   RCDPE MARK  FOR AUTOP OST
  1731   "KRN",101, 7967,-1)
  1732   4^14
  1733   "KRN",101, 7967,0)
  1734   RCDPE APAR  SPLIT LIN E
  1735   "KRN",101, 7968,-1)
  1736   0^11
  1737   "KRN",101, 7968,0)
  1738   RCDPE APAR  EEOB REFR ESH^Refres h Line^^A^ ^^^^^^^ACC OUNTS RECE IVABLE
  1739   "KRN",101, 7968,1,0)
  1740   ^101.06^3^ 3^3181004^ ^^^
  1741   "KRN",101, 7968,1,1,0 )
  1742   This optio n allows t he user to  'refresh'  the APAR   scratch p ad entry t o
  1743   "KRN",101, 7968,1,2,0 )
  1744   remove all  previousl y entered  edits/spli ts/adjustm ents and r estore it  to
  1745   "KRN",101, 7968,1,3,0 )
  1746   the state  it was in  before any  manual ch anges were  made.  
  1747   "KRN",101, 7968,4)
  1748   ^^^
  1749   "KRN",101, 7968,20)
  1750   D REFRESH^ RCDPEAA3(R CIENS)
  1751   "KRN",101, 7968,99)
  1752   64925,1946 0
  1753   "KRN",101, 7969,-1)
  1754   4^16
  1755   "KRN",101, 7969,0)
  1756   RCDPE APAR  RESEARCH
  1757   "KRN",101, 7971,-1)
  1758   4^15
  1759   "KRN",101, 7971,0)
  1760   RCDPE APAR  VIEW/PRIN T EOB
  1761   "KRN",101, 7973,-1)
  1762   4^17
  1763   "KRN",101, 7973,0)
  1764   RCDPE APAR  VERIFY
  1765   "KRN",101, 8008,-1)
  1766   0^5
  1767   "KRN",101, 8008,0)
  1768   RCDPE EFT  ERA MANUAL  MATCH^ERA  Manual Ma tch^^A^^^^ ^^^^ACCOUN TS RECEIVA BLE
  1769   "KRN",101, 8008,20)
  1770   D MATCHWL^ RCDPEM2
  1771   "KRN",101, 8008,28)
  1772   Manual Mat ch
  1773   "KRN",101, 8008,99)
  1774   64915,5130 4
  1775   "KRN",101, 8017,-1)
  1776   4^19
  1777   "KRN",101, 8017,0)
  1778   RCDPE APAR  CLAIM COM MENT
  1779   "KRN",101, 8416,-1)
  1780   0^7
  1781   "KRN",101, 8416,0)
  1782   RCDPE EFT  PARTIAL MA TCH SELECT ^Select EF T^^A^^^^^^ ^^ACCOUNTS  RECEIVABL E
  1783   "KRN",101, 8416,2,0)
  1784   ^101.02A^1 ^1
  1785   "KRN",101, 8416,2,1,0 )
  1786   SE
  1787   "KRN",101, 8416,2,"B" ,"SE",1)
  1788  
  1789   "KRN",101, 8416,4)
  1790   26^4
  1791   "KRN",101, 8416,20)
  1792   D SELEFT^R CDPEE
  1793   "KRN",101, 8416,99)
  1794   64803,2843 6
  1795   "KRN",101, 8417,-1)
  1796   0^6
  1797   "KRN",101, 8417,0)
  1798   RCDPE EFT  PARTIAL MA TCH MENU^^ ^M^^^^^^^^ ACCOUNTS R ECEIVABLE
  1799   "KRN",101, 8417,4)
  1800   26^4
  1801   "KRN",101, 8417,10,0)
  1802   ^101.01PA^ 2^2
  1803   "KRN",101, 8417,10,1, 0)
  1804   8416^SE^10 ^^^Select  EFT
  1805   "KRN",101, 8417,10,1, "^")
  1806   RCDPE EFT  PARTIAL MA TCH SELECT
  1807   "KRN",101, 8417,10,2, 0)
  1808   1697^^200^ ^^EXIT
  1809   "KRN",101, 8417,10,2, "^")
  1810   VALM QUIT
  1811   "KRN",101, 8417,15)
  1812  
  1813   "KRN",101, 8417,26)
  1814   D SHOW^VAL M
  1815   "KRN",101, 8417,28)
  1816   Select Act ion: 
  1817   "KRN",101, 8417,99)
  1818   64803,2870 5
  1819   "KRN",101, 8446,-1)
  1820   0^1
  1821   "KRN",101, 8446,0)
  1822   RCDPEX DUP  EXCEPTION  MENU^Dupl icate 835E RA Message s^^M^^^^^^ ^^ACCOUNTS  RECEIVABL E
  1823   "KRN",101, 8446,1,0)
  1824   ^101.06^2^ 2^3180801^ ^^^
  1825   "KRN",101, 8446,1,1,0 )
  1826   This is th e main men u that con tains the  actions th at can be
  1827   "KRN",101, 8446,1,2,0 )
  1828   manually p erformed o n duplicat e ERA mess ages
  1829   "KRN",101, 8446,4)
  1830   40^6
  1831   "KRN",101, 8446,10,0)
  1832   ^101.01PA^ 4^4
  1833   "KRN",101, 8446,10,1, 0)
  1834   1697^Q^100 ^^^Exit
  1835   "KRN",101, 8446,10,1, "^")
  1836   VALM QUIT
  1837   "KRN",101, 8446,10,2, 0)
  1838   8447^DM^30 ^
  1839   "KRN",101, 8446,10,2, "^")
  1840   RCDPEX DEL ETE DUP ME SSAGE
  1841   "KRN",101, 8446,10,3, 0)
  1842   8448^FM^20 ^
  1843   "KRN",101, 8446,10,3, "^")
  1844   RCDPEX FIL E DUPLICAT E MESSAGE
  1845   "KRN",101, 8446,10,4, 0)
  1846   8449^VP^10 ^
  1847   "KRN",101, 8446,10,4, "^")
  1848   RCDPEX VIE W/PRINT DU P MESSAGE
  1849   "KRN",101, 8446,15)
  1850   I $G(RCFAS TXT) S VAL MBCK="Q"
  1851   "KRN",101, 8446,26)
  1852   D SHOW^VAL M
  1853   "KRN",101, 8446,28)
  1854   Select Act ion: 
  1855   "KRN",101, 8446,99)
  1856   64867,2806 4
  1857   "KRN",101, 8447,-1)
  1858   0^2
  1859   "KRN",101, 8447,0)
  1860   RCDPEX DEL ETE DUP ME SSAGE^Dele te Dup Mes sage^^A^^R CDPE ERA E XCEPT^^^^^ ^ACCOUNTS  RECEIVABLE
  1861   "KRN",101, 8447,1,0)
  1862   ^101.06^4^ 4^3180730^ ^
  1863   "KRN",101, 8447,1,1,0 )
  1864   This actio n allows a  user to m anually de lete a dup licate ERA  message
  1865   "KRN",101, 8447,1,2,0 )
  1866   that eithe r cannot c ontinue, o r is not w anted to c ontinue,
  1867   "KRN",101, 8447,1,3,0 )
  1868   through th e EDI Lock box messag e process.   
  1869   "KRN",101, 8447,1,4,0 )
  1870   A MailMan  message is  sent to a lert that  this actio n has been  taken.
  1871   "KRN",101, 8447,20)
  1872   D DEL^RCDP EX5
  1873   "KRN",101, 8447,99)
  1874   64859,6978 8
  1875   "KRN",101, 8448,-1)
  1876   0^3
  1877   "KRN",101, 8448,0)
  1878   RCDPEX FIL E DUPLICAT E MESSAGE^ File Messa ge^^A^^^^^ ^^^
  1879   "KRN",101, 8448,1,0)
  1880   ^101.06^2^ 2^3180801^ ^
  1881   "KRN",101, 8448,1,1,0 )
  1882   This actio n allows a  user to m anually fo rce a dupl icate  
  1883   "KRN",101, 8448,1,2,0 )
  1884   ERA messag e to proce ss through  the EDI L ockbox ERA /EOB file  process.
  1885   "KRN",101, 8448,4)
  1886   ^6
  1887   "KRN",101, 8448,20)
  1888   D UPD^RCDP EX5
  1889   "KRN",101, 8448,99)
  1890   64859,7004 5
  1891   "KRN",101, 8449,-1)
  1892   0^4
  1893   "KRN",101, 8449,0)
  1894   RCDPEX VIE W/PRINT DU P MESSAGE^ View/Print  Dup. Mess age^^A^^^^ ^^^^ACCOUN TS RECEIVA BLE
  1895   "KRN",101, 8449,1,0)
  1896   ^^2^2^3180 730^
  1897   "KRN",101, 8449,1,1,0 )
  1898   This actio n allows t he user to  view a du plicate ED I Lockbox                    
  1899   "KRN",101, 8449,1,2,0 )
  1900   ERA messag e.
  1901   "KRN",101, 8449,20)
  1902   D VP^RCDPE X5
  1903   "KRN",101, 8449,99)
  1904   64859,7075 9
  1905   "KRN",409. 61,790,-1)
  1906   0^2
  1907   "KRN",409. 61,790,0)
  1908   RCDP LIST  OF RECEIPT S REPORT^1 ^^85^6^20^ 1^1^^RCDP  LIST OF RE CEIPTS MEN U^LIST OF  RECEIPTS^1 ^^1
  1909   "KRN",409. 61,790,1)
  1910   ^VALM HIDD EN ACTIONS
  1911   "KRN",409. 61,790,"AR RAY")
  1912  
  1913   "KRN",409. 61,790,"CO L",0)
  1914   ^409.621^9 ^9
  1915   "KRN",409. 61,790,"CO L",1,0)
  1916   DATE OPENE D^7^8^DATE
  1917   "KRN",409. 61,790,"CO L",2,0)
  1918   RECEIPT^16 ^12^RECEIP T
  1919   "KRN",409. 61,790,"CO L",3,0)
  1920   TYPE^29^5^ TYPE
  1921   "KRN",409. 61,790,"CO L",4,0)
  1922   USER INITI ALS^35^7^U SER
  1923   "KRN",409. 61,790,"CO L",5,0)
  1924   COUNT^43^5 ^COUNT
  1925   "KRN",409. 61,790,"CO L",6,0)
  1926   AMOUNT^53^ 6^AMOUNT
  1927   "KRN",409. 61,790,"CO L",7,0)
  1928   FMS DOC^61 ^13^FMS CR  DOC
  1929   "KRN",409. 61,790,"CO L",8,0)
  1930   STATUS^75^ 6^STATUS
  1931   "KRN",409. 61,790,"CO L",9,0)
  1932   LINE^1^4^  #
  1933   "KRN",409. 61,790,"CO L","B","AM OUNT",6)
  1934  
  1935   "KRN",409. 61,790,"CO L","B","CO UNT",5)
  1936  
  1937   "KRN",409. 61,790,"CO L","B","DA TE OPENED" ,1)
  1938  
  1939   "KRN",409. 61,790,"CO L","B","FM S DOC",7)
  1940  
  1941   "KRN",409. 61,790,"CO L","B","LI NE",9)
  1942  
  1943   "KRN",409. 61,790,"CO L","B","RE CEIPT",2)
  1944  
  1945   "KRN",409. 61,790,"CO L","B","ST ATUS",8)
  1946  
  1947   "KRN",409. 61,790,"CO L","B","TY PE",3)
  1948  
  1949   "KRN",409. 61,790,"CO L","B","US ER INITIAL S",4)
  1950  
  1951   "KRN",409. 61,790,"FN L")
  1952   D EXIT^RCD PRL
  1953   "KRN",409. 61,790,"HD R")
  1954   D HDR^RCDP RL
  1955   "KRN",409. 61,790,"HL P")
  1956   D HELP^RCD PRL
  1957   "KRN",409. 61,790,"IN IT")
  1958   D INIT^RCD PRL
  1959   "KRN",409. 61,803,-1)
  1960   0^4
  1961   "KRN",409. 61,803,0)
  1962   RCDPE EFT  PARTIAL MA TCH^1^^80^ 9^20^1^1^^ RCDPE EFT  PARTIAL MA TCH MENU^E FT Selecti on^1^^1
  1963   "KRN",409. 61,803,1)
  1964   ^VALM HIDD EN ACTIONS
  1965   "KRN",409. 61,803,"AR RAY")
  1966    ^TMP("RCP M-WL",$J)
  1967   "KRN",409. 61,803,"CO L",0)
  1968   ^409.621^1 ^1
  1969   "KRN",409. 61,803,"CO L",1,0)
  1970   PAYER NAME /TIN^7^73^ Payer Name /TIN
  1971   "KRN",409. 61,803,"CO L","B","PA YER NAME/T IN",1)
  1972  
  1973   "KRN",409. 61,803,"FN L")
  1974   D EXIT^RCD PEE
  1975   "KRN",409. 61,803,"HD R")
  1976   D HDR^RCDP EE
  1977   "KRN",409. 61,803,"HL P")
  1978   D HELP^RCD PEE
  1979   "KRN",409. 61,803,"IN IT")
  1980   D INIT^RCD PEE
  1981   "KRN",409. 61,808,-1)
  1982   0^1
  1983   "KRN",409. 61,808,0)
  1984   RCDPEX DUP LICATE ERA  LIST^1^^8 0^5^19^1^1 ^EDI Lockb ox Duplica te ERA^RCD PEX DUP EX CEPTION ME NU^DUPLICA TE ERA TRA NSMISSIONS ^1^^1
  1985   "KRN",409. 61,808,1)
  1986   ^VALM HIDD EN ACTIONS
  1987   "KRN",409. 61,808,"AR RAY")
  1988    ^TMP("RCD PEX-EOB",$ J)
  1989   "KRN",409. 61,808,"CO L",0)
  1990   ^409.621^5 ^5
  1991   "KRN",409. 61,808,"CO L",1,0)
  1992   NUMBER^1^4 ^#
  1993   "KRN",409. 61,808,"CO L",2,0)
  1994   MSG_ID^7^2 0^Message  ID
  1995   "KRN",409. 61,808,"CO L",3,0)
  1996   MSG_TYPE^2 9^7^MsgTyp e
  1997   "KRN",409. 61,808,"CO L",4,0)
  1998   REC_DATE^3 8^20^Date  Received
  1999   "KRN",409. 61,808,"CO L",5,0)
  2000   MAIL MESSA GE #^60^17 ^Mail Mess age #
  2001   "KRN",409. 61,808,"CO L","B","MA IL MESSAGE  #",5)
  2002  
  2003   "KRN",409. 61,808,"CO L","B","MS G_ID",2)
  2004  
  2005   "KRN",409. 61,808,"CO L","B","MS G_TYPE",3)
  2006  
  2007   "KRN",409. 61,808,"CO L","B","NU MBER",1)
  2008  
  2009   "KRN",409. 61,808,"CO L","B","RE C_DATE",4)
  2010  
  2011   "KRN",409. 61,808,"FN L")
  2012   D FNL^RCDP EX1
  2013   "KRN",409. 61,808,"HD R")
  2014   D HDR1^RCD PEX1
  2015   "KRN",409. 61,808,"IN IT")
  2016   D INITD^RC DPEX1
  2017   "KRN",409. 61,809,-1)
  2018   0^5
  2019   "KRN",409. 61,809,0)
  2020   RCDPE VIEW  ERA DETAI L^2^^80^2^ 21^0^1^^^V iew ERA De tail^1^^1
  2021   "KRN",409. 61,809,1)
  2022   ^VALM HIDD EN ACTIONS
  2023   "KRN",409. 61,809,"FN L")
  2024   D LMEXIT^R CDPEARL
  2025   "KRN",409. 61,809,"HD R")
  2026   D LMHDR^RC DPEARL
  2027   "KRN",409. 61,809,"HL P")
  2028   D LMHLP^RC DPEARL
  2029   "KRN",409. 61,809,"IN IT")
  2030   D LMINIT^R CDPEARL
  2031   "KRN",409. 61,810,-1)
  2032   0^3
  2033   "KRN",409. 61,810,0)
  2034   RCDPE EEOB  MARKED FO R AP AUDIT ^2^^80^7^2 1^1^1^^^EE OBs MARKED  FOR AP AU DIT^1^^1
  2035   "KRN",409. 61,810,1)
  2036   ^VALM HIDD EN ACTIONS
  2037   "KRN",409. 61,810,"FN L")
  2038   D LMEXIT^R CDPEARL
  2039   "KRN",409. 61,810,"HD R")
  2040   D LMHDR^RC DPEARL
  2041   "KRN",409. 61,810,"HL P")
  2042   D LMHLP^RC DPEARL
  2043   "KRN",409. 61,810,"IN IT")
  2044   D LMINIT^R CDPEARL
  2045   "MBREQ")
  2046   1
  2047   "ORD",15,1 01)
  2048   101;15;;;P RO^XPDTA;P ROF1^XPDIA ;PROE1^XPD IA;PROF2^X PDIA;;PROD EL^XPDIA
  2049   "ORD",15,1 01,0)
  2050   PROTOCOL
  2051   "ORD",17,4 09.61)
  2052   409.61;17; 1;;;;LME1^ XPDIA1;;;L MDEL^XPDIA 1
  2053   "ORD",17,4 09.61,0)
  2054   LIST TEMPL ATE
  2055   "ORD",18,1 9)
  2056   19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
  2057   "ORD",18,1 9,0)
  2058   OPTION
  2059   "PKG",561, -1)
  2060   1^1
  2061   "PKG",561, 0)
  2062   ACCOUNTS R ECEIVABLE^ PRCA^FMS
  2063   "PKG",561, 22,0)
  2064   ^9.49I^1^1
  2065   "PKG",561, 22,1,0)
  2066   4.5^295032 0^2950331
  2067   "PKG",561, 22,1,"PAH" ,1,0)
  2068   332^318121 4
  2069   "PKG",561, 22,1,"PAH" ,1,1,0)
  2070   ^^1^1^3181 214
  2071   "PKG",561, 22,1,"PAH" ,1,1,1,0)
  2072   MCCF EDI T AS EPAYMEN TS BUILD 3
  2073   "QUES","XP F1",0)
  2074   Y
  2075   "QUES","XP F1","??")
  2076   ^D REP^XPD H
  2077   "QUES","XP F1","A")
  2078   Shall I wr ite over y our |FLAG|  File
  2079   "QUES","XP F1","B")
  2080   YES
  2081   "QUES","XP F1","M")
  2082   D XPF1^XPD IQ
  2083   "QUES","XP F2",0)
  2084   Y
  2085   "QUES","XP F2","??")
  2086   ^D DTA^XPD H
  2087   "QUES","XP F2","A")
  2088   Want my da ta |FLAG|  yours
  2089   "QUES","XP F2","B")
  2090   YES
  2091   "QUES","XP F2","M")
  2092   D XPF2^XPD IQ
  2093   "QUES","XP I1",0)
  2094   YO
  2095   "QUES","XP I1","??")
  2096   ^D INHIBIT ^XPDH
  2097   "QUES","XP I1","A")
  2098   Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  2099   "QUES","XP I1","B")
  2100   NO
  2101   "QUES","XP I1","M")
  2102   D XPI1^XPD IQ
  2103   "QUES","XP M1",0)
  2104   PO^VA(200, :EM
  2105   "QUES","XP M1","??")
  2106   ^D MG^XPDH
  2107   "QUES","XP M1","A")
  2108   Enter the  Coordinato r for Mail  Group '|F LAG|'
  2109   "QUES","XP M1","B")
  2110  
  2111   "QUES","XP M1","M")
  2112   D XPM1^XPD IQ
  2113   "QUES","XP O1",0)
  2114   Y
  2115   "QUES","XP O1","??")
  2116   ^D MENU^XP DH
  2117   "QUES","XP O1","A")
  2118   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  2119   "QUES","XP O1","B")
  2120   YES
  2121   "QUES","XP O1","M")
  2122   D XPO1^XPD IQ
  2123   "QUES","XP Z1",0)
  2124   Y
  2125   "QUES","XP Z1","??")
  2126   ^D OPT^XPD H
  2127   "QUES","XP Z1","A")
  2128   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  2129   "QUES","XP Z1","B")
  2130   NO
  2131   "QUES","XP Z1","M")
  2132   D XPZ1^XPD IQ
  2133   "QUES","XP Z2",0)
  2134   Y
  2135   "QUES","XP Z2","??")
  2136   ^D RTN^XPD H
  2137   "QUES","XP Z2","A")
  2138   Want to MO VE routine s to other  CPUs
  2139   "QUES","XP Z2","B")
  2140   NO
  2141   "QUES","XP Z2","M")
  2142   D XPZ2^XPD IQ
  2143   "RTN")
  2144   44
  2145   "RTN","PRC ABJ2")
  2146   0^39^B2049 2059
  2147   "RTN","PRC ABJ2",1,0)
  2148   PRCABJ2 ;O IT/hrub -  NIGHTLY PR OCESS FOR  ACCOUNTS R ECEIVABLE  ;31 Oct 20 18 16:00:5 9
  2149   "RTN","PRC ABJ2",2,0)
  2150    ;;4.5;Acc ounts Rece ivable;**3 04,321,326 ,332**;Mar  20, 1995; Build 34
  2151   "RTN","PRC ABJ2",3,0)
  2152    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  2153   "RTN","PRC ABJ2",4,0)
  2154    ;
  2155   "RTN","PRC ABJ2",5,0)
  2156    ; read of  ^DGCR(399 .2 allowed  by DBIA 3 822
  2157   "RTN","PRC ABJ2",6,0)
  2158    ; refacto red 17 Oct ober 2018,  PRCA*4.5* 332
  2159   "RTN","PRC ABJ2",7,0)
  2160    Q
  2161   "RTN","PRC ABJ2",8,0)
  2162    ; Auto-au dit Paper,  Electroni c, and Tri care bills  if ready
  2163   "RTN","PRC ABJ2",9,0)
  2164    ; PRCA*4. 5*332 - Wh ole subrou tine re-wr itten
  2165   "RTN","PRC ABJ2",10,0 )
  2166   ABAUDIT ;
  2167   "RTN","PRC ABJ2",11,0 )
  2168    ; APIEN -  Accounts  Payable (f ile #430)  ien (also  same ien f or file #3 99)
  2169   "RTN","PRC ABJ2",12,0 )
  2170    N APIEN,A RBILL,C,FL AG,J,PRCA, RTYPE  ;PR CA*4.5*321 , PRCA*4.5 *332
  2171   "RTN","PRC ABJ2",13,0 )
  2172    ;
  2173   "RTN","PRC ABJ2",14,0 )
  2174    S ARBILL( "newBillIE N")=$O(^PR CA(430.3," B","NEW BI LL",""))   ; New Bill  IEN
  2175   "RTN","PRC ABJ2",15,0 )
  2176    Q:ARBILL( "newBillIE N")=""  ;  must have  the IEN fo r new bill s
  2177   "RTN","PRC ABJ2",16,0 )
  2178    ; Check p arameters  to see if  audit need s to run
  2179   "RTN","PRC ABJ2",17,0 )
  2180    S FLAG("a aMedPaper" )=$$GET1^D IQ(342,"1, ",7.05,"I" )  ; (#7.0 5) AUTO-AU DIT MEDICA L PAPER BI LLS [5S]
  2181   "RTN","PRC ABJ2",18,0 )
  2182    S FLAG("a aRxPaper") =$$GET1^DI Q(342,"1," ,7.06,"I")   ; (#7.06 ) AUTO-AUD IT RX PAPE R BILLS [6 S]
  2183   "RTN","PRC ABJ2",19,0 )
  2184    S FLAG("a aMedEDI")= $$GET1^DIQ (342,"1,", 7.07,"I")   ; (#7.07)  AUTO-AUDI T MEDICAL  EDI BILLS  [7S] - PRC A*4.5*321
  2185   "RTN","PRC ABJ2",20,0 )
  2186    S FLAG("a aRxEDI")=$ $GET1^DIQ( 342,"1,",7 .08,"I")   ; (#7.08)  AUTO-AUDIT  RX EDI BI LLS [8S] -  PRCA*4.5* 321
  2187   "RTN","PRC ABJ2",21,0 )
  2188    S FLAG("a aTricare") =$$GET1^DI Q(342,"1," ,7.09,"I")  ; (#7.09)  AUTO-AUDI T TRICARE  BILLS [9S]  - PRCA*4. 5*332
  2189   "RTN","PRC ABJ2",22,0 )
  2190    ; quit if  all auto- audit para meters are  'No'
  2191   "RTN","PRC ABJ2",23,0 )
  2192    Q:('FLAG( "aaMedPape r"))&('FLA G("aaRxPap er"))&('FL AG("aaMedE DI"))&('FL AG("aaRxED I"))&('FLA G("aaTrica re"))  ; P RCA*4.5*32 1
  2193   "RTN","PRC ABJ2",24,0 )
  2194    ;
  2195   "RTN","PRC ABJ2",25,0 )
  2196    ; RTYPE -  array of  RATE TYPE  entries th at have (# .11) BILL  RESULTING  FROM [11P: 430.6] - P RCA*4.5*33 2
  2197   "RTN","PRC ABJ2",26,0 )
  2198    S C=0 F   S C=$O(^DG CR(399.3,C )) Q:'C  S  J=$G(^(C, 0)) S:$P(J ,U,11) RTY PE(C)=J
  2199   "RTN","PRC ABJ2",27,0 )
  2200    ; loop th rough new  bills
  2201   "RTN","PRC ABJ2",28,0 )
  2202    ; BILL -  info for t his bill
  2203   "RTN","PRC ABJ2",29,0 )
  2204    ; PRCA -  bill # and  ECME info
  2205   "RTN","PRC ABJ2",30,0 )
  2206    ; RTDGCR  - used for  file #399  info (exc ept rate t ype)
  2207   "RTN","PRC ABJ2",31,0 )
  2208    S APIEN=" " F  S API EN=$O(^PRC A(430,"AC" ,ARBILL("n ewBillIEN" ),APIEN))  Q:'APIEN   D
  2209   "RTN","PRC ABJ2",32,0 )
  2210    . N BILL, PRCA,RTDGC R
  2211   "RTN","PRC ABJ2",33,0 )
  2212    . ;
  2213   "RTN","PRC ABJ2",34,0 )
  2214    . S BILL( "rtTyp")=$ $GET1^DIQ( 399,APIEN_ ",",.07,"I ") ; (#.07 ) RATE TYP E [7P:399. 3] - PRCA* 4.5*326
  2215   "RTN","PRC ABJ2",35,0 )
  2216    . Q:'BILL ("rtTyp")   ; must ha ve rate ty pe
  2217   "RTN","PRC ABJ2",36,0 )
  2218    . Q:'$D(R TYPE(BILL( "rtTyp")))   ; no aut o-audit fo r this RAT E TYPE
  2219   "RTN","PRC ABJ2",37,0 )
  2220    . ; BEGIN  - PRCA*4. 5*321
  2221   "RTN","PRC ABJ2",38,0 )
  2222    . Q:$$GET 1^DIQ(430, APIEN_",", 7,"I")=""   ; quit if  no (#7) P ATIENT [7P :2]
  2223   "RTN","PRC ABJ2",39,0 )
  2224    . Q:$$GET 1^DIQ(430, APIEN_",", 9,"I")=""   ; quit if  no (#9) D EBTOR [9P: 340]
  2225   "RTN","PRC ABJ2",40,0 )
  2226    . Q:$$GET 1^DIQ(430, APIEN_",", 239,"I")=" "  ; quit  if no (#23 9) INSURED  NAME [1F]
  2227   "RTN","PRC ABJ2",41,0 )
  2228    . Q:$$GET 1^DIQ(430, APIEN_",", 243,"I")=" "  ; quit  if no (#24 3) GROUP N AME [5F]
  2229   "RTN","PRC ABJ2",42,0 )
  2230    . Q:$$GET 1^DIQ(430, APIEN_",", 244,"I")=" "  ; quit  if no (#24 4) GROUP N UMBER [6F]
  2231   "RTN","PRC ABJ2",43,0 )
  2232    . Q:$$BIL LREJ^PRCAU DT(APIEN)   ; PRCA*4. 5*321 - cl aim has re ject messa ges, do no t audit
  2233   "RTN","PRC ABJ2",44,0 )
  2234    . ;
  2235   "RTN","PRC ABJ2",45,0 )
  2236    . S RTDGC R("type")= $$GET1^DIQ (399,APIEN _",",.07," E")  ; (#. 07) RATE T YPE [7P:39 9.3] (IA 4 118)
  2237   "RTN","PRC ABJ2",46,0 )
  2238    . S RTDGC R("paper") =$$GET1^DI Q(399,APIE N_",",27," I")  ; (#. 27) BILL C HARGE TYPE  [27S] (IC R 3820)
  2239   "RTN","PRC ABJ2",47,0 )
  2240    . S BILL( "audit?")= 0  ; Boole an flag, n eed to aud it bill?
  2241   "RTN","PRC ABJ2",48,0 )
  2242    . S BILL( "doneCheck ?")=0  ; B oolean fla g, done ch ecking?
  2243   "RTN","PRC ABJ2",49,0 )
  2244    . ; Get B ill number  to check  if it's a  Pharmacy b ill
  2245   "RTN","PRC ABJ2",50,0 )
  2246    . S PRCA( "bill#")=$ $GET1^DIQ( 430,APIEN_ ",",.01,"I ")  ; (#.0 1) BILL NO . [1F]
  2247   "RTN","PRC ABJ2",51,0 )
  2248    . S PRCA( "ecme#")=$ $GETECME^R CDPENR1(AP IEN)  ; EC ME# from t he bill
  2249   "RTN","PRC ABJ2",52,0 )
  2250    . ;
  2251   "RTN","PRC ABJ2",53,0 )
  2252    . I PRCA( "ecme#")'= "" D  ; ha s ECME#, c heck pharm acy flags
  2253   "RTN","PRC ABJ2",54,0 )
  2254    ..  I RTD GCR("paper "),'FLAG(" aaRxPaper" ) S BILL(" doneCheck? ")=1 Q  ;  Skip paper  bill if N o auto-aud it
  2255   "RTN","PRC ABJ2",55,0 )
  2256    ..  I 'RT DGCR("pape r"),'FLAG( "aaRxEDI")   S BILL(" doneCheck? ")=1 Q  ;  Skip EDI b ill if No  auto-audit
  2257   "RTN","PRC ABJ2",56,0 )
  2258    ..  S BIL L("audit?" )="1^pharm acy"  ; au dit this p harmacy bi ll
  2259   "RTN","PRC ABJ2",57,0 )
  2260    . ;
  2261   "RTN","PRC ABJ2",58,0 )
  2262    . I BILL( "audit?")  D AUDITX^P RCAUDT(API EN) Q  ; a udit pharm acy bill,  continue l oop
  2263   "RTN","PRC ABJ2",59,0 )
  2264    . Q:BILL( "doneCheck ?")  ; don e checking , continue  loop thro ugh bills
  2265   "RTN","PRC ABJ2",60,0 )
  2266    . ;
  2267   "RTN","PRC ABJ2",61,0 )
  2268    . I RTDGC R("type")[ "TRICARE"  D
  2269   "RTN","PRC ABJ2",62,0 )
  2270    ..  I FLA G("aaTrica re") S BIL L("audit?" )="1^Trica re"  ; aud it this Tr icare bill
  2271   "RTN","PRC ABJ2",63,0 )
  2272    ..  S BIL L("doneChe ck?")=1
  2273   "RTN","PRC ABJ2",64,0 )
  2274    . I BILL( "audit?")  D AUDITX^P RCAUDT(API EN) Q  ; a udit Trica re bill, c ontinue lo op
  2275   "RTN","PRC ABJ2",65,0 )
  2276    . Q:BILL( "doneCheck ?")  ;  do ne checkin g, continu e loop thr ough bills
  2277   "RTN","PRC ABJ2",66,0 )
  2278    . D  ; me dical bill , check me dical flag s
  2279   "RTN","PRC ABJ2",67,0 )
  2280    ..  I RTD GCR("paper "),'FLAG(" aaMedPaper ") S BILL( "doneCheck ?")=1 Q  ;  Skip pape r bill if  No auto-au dit
  2281   "RTN","PRC ABJ2",68,0 )
  2282    ..  I 'RT DGCR("pape r"),'FLAG( "aaMedEDI" )  S BILL( "doneCheck ?")=1 Q  ;  Skip EDI  bill if No  auto-audi t
  2283   "RTN","PRC ABJ2",69,0 )
  2284    ..  S BIL L("audit?" )="1^medic al"  ; aud it this me dical bill
  2285   "RTN","PRC ABJ2",70,0 )
  2286    . Q:BILL( "doneCheck ?")  ; no  auto-audit  for medic al bill
  2287   "RTN","PRC ABJ2",71,0 )
  2288    . ; passe d medical  checks cal l auto-aud it for thi s Bill
  2289   "RTN","PRC ABJ2",72,0 )
  2290    . I BILL( "audit?")  D AUDITX^P RCAUDT(API EN)
  2291   "RTN","PRC ABJ2",73,0 )
  2292    ;
  2293   "RTN","PRC ABJ2",74,0 )
  2294    Q
  2295   "RTN","PRC ABJ2",75,0 )
  2296    ;
  2297   "RTN","PRC AEXM")
  2298   0^40^B1545 8126
  2299   "RTN","PRC AEXM",1,0)
  2300   PRCAEXM ;S F-ISC/YJK- ADMIN.COST  CHARGE TR ANSACTION  ;15 Nov 20 18 13:51:1 8
  2301   "RTN","PRC AEXM",2,0)
  2302    ;;4.5;Acc ounts Rece ivable;**6 7,103,196, 301,318,31 5,332**;Ma r 20, 1995 ;Build 34
  2303   "RTN","PRC AEXM",3,0)
  2304    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  2305   "RTN","PRC AEXM",4,0)
  2306    ;
  2307   "RTN","PRC AEXM",5,0)
  2308    ;Update I nt/adm.bal ance and A dministrat ive cost c harge tran saction, i s called b y ^PRCAWO.
  2309   "RTN","PRC AEXM",6,0)
  2310    ;
  2311   "RTN","PRC AEXM",7,0)
  2312    D EN1(0)   ; Adminis trative Co st Adjustm ent [PRCAF  ADJ ADMIN ] option e ntry point , PRCA*4.5 *332
  2313   "RTN","PRC AEXM",8,0)
  2314    Q
  2315   "RTN","PRC AEXM",9,0)
  2316    ;
  2317   "RTN","PRC AEXM",10,0 )
  2318   EN1(KEYCHK ) ;Adjustm ent Intere st/admin.c ost from a n AR - thi s makes th e int/adm. balance
  2319   "RTN","PRC AEXM",11,0 )
  2320    ;  ,marsh al fee and  court cos t zero,0.
  2321   "RTN","PRC AEXM",12,0 )
  2322    ; KEYCHK  (optional)  - 1 check  for RCDPE AR securit y key, zer o otherwis e, default s to zero
  2323   "RTN","PRC AEXM",13,0 )
  2324    N PRCAIND ,ADMINTOT, PRCAERR,PR CABN0
  2325   "RTN","PRC AEXM",14,0 )
  2326    I '$D(KEY CHK) N KEY CHK S KEYC HK=0
  2327   "RTN","PRC AEXM",15,0 )
  2328    I $G(KEYC HK)=1,'$D( ^XUSEC("RC DPEAR",DUZ )) D  Q  ;  PRCA*4.5* 318 Added  security k ey check
  2329   "RTN","PRC AEXM",16,0 )
  2330    . W !!,"T his action  can only  be taken b y users th at have th e RCDPEAR  security k ey.",!
  2331   "RTN","PRC AEXM",17,0 )
  2332    . S VALMB CK="R"
  2333   "RTN","PRC AEXM",18,0 )
  2334    . D PAUSE ^VALM1
  2335   "RTN","PRC AEXM",19,0 )
  2336   RTRN ; lin e tag for  GOTO retur n
  2337   "RTN","PRC AEXM",20,0 )
  2338    D BEGIN^P RCAWO G:(' $D(PRCABN) )!('$D(PRC AEN)) END  G:'$D(^PRC A(430,PRCA BN,7)) END
  2339   "RTN","PRC AEXM",21,0 )
  2340    L +^PRCA( 430,PRCABN ):1 I '$T  W !!,*7,"A NOTHER USE R IS EDITI NG THIS BI LL" G RTRN
  2341   "RTN","PRC AEXM",22,0 )
  2342    S PRCABN0 =PRCABN
  2343   "RTN","PRC AEXM",23,0 )
  2344    S PRCAIND =$G(^PRCA( 430,PRCABN ,7))
  2345   "RTN","PRC AEXM",24,0 )
  2346    S PRCAMT= $P(PRCAIND ,U,2)+$P(P RCAIND,U,3 )+$P(PRCAI ND,U,4)+$P (PRCAIND,U ,5)
  2347   "RTN","PRC AEXM",25,0 )
  2348    S %=$P(^P RCA(430,PR CABN,0),U, 2) I "PC"' [$P(^PRCA( 430.2,%,0) ,U,6) W *7 ,!,"This A R may not  be appropr iate to ch arge Inter est/Admini strative c ost.",!,"P lease chec k the cate gory of th is AR.",!  H 3
  2349   "RTN","PRC AEXM",26,0 )
  2350    K % W !!, "You may e xempt the  account fr om all the  interest  and admini strative c ost balanc es - makin g those ba lances zer o (0),",!, "or adjust  them."
  2351   "RTN","PRC AEXM",27,0 )
  2352   EN011 S %= 2 W !!,"Do  you want  to exempt  the accoun t from all  the Int/A dm. costs"  D YN^DICN  I %<0 S P RCACOMM="U ser Cancel led" D DEL ETE^PRCAWO 1 K PRCACO MM G RTRN
  2353   "RTN","PRC AEXM",28,0 )
  2354    I %=1 D E N11,END G  RTRN
  2355   "RTN","PRC AEXM",29,0 )
  2356    I %=0 W ! ,"ANSWER ' YES' OR 'N O' " G EN0 11
  2357   "RTN","PRC AEXM",30,0 )
  2358    W !,"Adju sting the  administra tive/Inter est charge  ...",!
  2359   "RTN","PRC AEXM",31,0 )
  2360    D DIEEN^P RCAWO1,END  G RTRN
  2361   "RTN","PRC AEXM",32,0 )
  2362    ;
  2363   "RTN","PRC AEXM",33,0 )
  2364    ;  exempt  interest  and admin  charges
  2365   "RTN","PRC AEXM",34,0 )
  2366   EN11 S PRC ATYPE=14,D IE="^PRCA( 433,",DA=P RCAEN
  2367   "RTN","PRC AEXM",35,0 )
  2368    S DR=".03 ////^S X=" _PRCABN_"; 11////^S X ="_DT_";12 ////^S X=" _PRCATYPE_ ";15////^S  X="_PRCAM T_";"
  2369   "RTN","PRC AEXM",36,0 )
  2370    S DR=DR_" 27////^S X ="_+$P(PRC AIND,U,2)_ ";"  ;inte rest
  2371   "RTN","PRC AEXM",37,0 )
  2372    S DR=DR_" 28////^S X ="_+$P(PRC AIND,U,3)_ ";"  ;admi n charge
  2373   "RTN","PRC AEXM",38,0 )
  2374    S DR=DR_" 25////^S X ="_+$P(PRC AIND,U,4)_ ";"  ;mars hal fee
  2375   "RTN","PRC AEXM",39,0 )
  2376    S DR=DR_" 26////^S X ="_+$P(PRC AIND,U,5)_ ";"  ;cour t cost
  2377   "RTN","PRC AEXM",40,0 )
  2378    S DIC=DIE ,PRCA("LOC K")=0 D LO CKF^PRCAWO 1 Q:PRCA(" LOCK")=1   D ^DIE
  2379   "RTN","PRC AEXM",41,0 )
  2380    I PRCAEN, $D(^PRCA(4 30,"TCSP", PRCABN)) D  DECADJ^RC TCSPU(PRCA BN,PRCAEN)  ;prca*4.5 *301 add c s 5B flag
  2381   "RTN","PRC AEXM",42,0 )
  2382    S $P(^PRC A(430,PRCA BN,7),U,2, 5)="0^0^0^ 0" D TRANS T^PRCAWO1  Q
  2383   "RTN","PRC AEXM",43,0 )
  2384    ;
  2385   "RTN","PRC AEXM",44,0 )
  2386    ;
  2387   "RTN","PRC AEXM",45,0 )
  2388   EN2 Q:'$D( PRCAEN)  Q :($P(^PRCA (433,PRCAE N,2),U,8)= "")&($P(^P RCA(433,PR CAEN,2),U, 7)="")
  2389   "RTN","PRC AEXM",46,0 )
  2390    W !,"MONT HLY ADMIN.  CHARGE: " ,?25,+$P(^ PRCA(433,P RCAEN,2),U ,8),?40,"I NTEREST CH ARGE: ",+$ P(^PRCA(43 3,PRCAEN,2 ),U,7) Q
  2391   "RTN","PRC AEXM",47,0 )
  2392    ;
  2393   "RTN","PRC AEXM",48,0 )
  2394   END L -^PR CA(433,+$G (PRCAEN)), -^PRCA(430 ,+$G(PRCAB N))
  2395   "RTN","PRC AEXM",49,0 )
  2396    S X(1)=0, X=$G(^PRCA (430,+$G(P RCABN0),7) ),X(1)=+X, X(1)=$P(X, "^",2)+X(1 ),X(1)=$P( X,"^",3)+X (1),X(1)=$ P(X,"^",4) +X(1),X(1) =$P(X,"^", 5)+X(1)
  2397   "RTN","PRC AEXM",50,0 )
  2398    K PRCA("S TATUS")
  2399   "RTN","PRC AEXM",51,0 )
  2400    I X(1)=0, $G(PRCABN0 ) D
  2401   "RTN","PRC AEXM",52,0 )
  2402    .;Check f or payment  transacti ons
  2403   "RTN","PRC AEXM",53,0 )
  2404    .F X=0:0  S X=$O(^PR CA(433,"C" ,PRCABN0,X )) Q:'X  I  ",2,7,20, "[(","_$P( $G(^PRCA(4 30.3,+$P($ G(^PRCA(43 3,X,1)),"^ ",2),0))," ^",3)_",")  S PRCA("S TATUS")=$O (^PRCA(430 .3,"AC",10 8,0))
  2405   "RTN","PRC AEXM",54,0 )
  2406    .S:'$D(PR CA("STATUS ")) PRCA(" STATUS")=$ O(^PRCA(43 0.3,"AC",1 11,0))
  2407   "RTN","PRC AEXM",55,0 )
  2408    .S DA=PRC ABN0,DIE=" ^PRCA(430, ",DR="8/// /"_PRCA("S TATUS") D  ^DIE
  2409   "RTN","PRC AEXM",56,0 )
  2410    K PRCATY, PRCA,PRCA2 ,PRCAD,PRC ABN,PRCAEN ,PRCATYPE, DA,DIE,DIC ,PRCAMT,DR ,X,% Q
  2411   "RTN","PRC AEXM",57,0 )
  2412    ;
  2413   "RTN","RCB EADJ1")
  2414   0^29^B1858 6021
  2415   "RTN","RCB EADJ1",1,0 )
  2416   RCBEADJ1 ; ALB/PJH -  PENDING PA YMENTS ;24 -FEB-03
  2417   "RTN","RCB EADJ1",2,0 )
  2418    ;;4.5;Acc ounts Rece ivable;**1 73,276,321 ,326,332** ;Mar 20, 1 995;Build  34
  2419   "RTN","RCB EADJ1",3,0 )
  2420    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  2421   "RTN","RCB EADJ1",4,0 )
  2422    Q
  2423   "RTN","RCB EADJ1",5,0 )
  2424   WARN(RCBIL LDA) ; Dis play warni ng if pend ing paymen ts exist E P ^RCBEADJ  
  2425   "RTN","RCB EADJ1",6,0 )
  2426    ; Input -  RCBILLDA  - Pointer  #430 - req uired
  2427   "RTN","RCB EADJ1",7,0 )
  2428    ; Output  - None - o utput to s creen only
  2429   "RTN","RCB EADJ1",8,0 )
  2430    ;
  2431   "RTN","RCB EADJ1",9,0 )
  2432    ; Check f or valid i nput
  2433   "RTN","RCB EADJ1",10, 0)
  2434    Q:'$G(RCB ILLDA)
  2435   "RTN","RCB EADJ1",11, 0)
  2436    ;
  2437   "RTN","RCB EADJ1",12, 0)
  2438    N DEBTOR, RCAMT,RCEO B,RCERA,RC LINE,RCPAI D,RCPEND,R CRCPT,RCRC PTN,RCSUB, RCTOT,RCTR ACE,RCTRAN DA,RCZ,RCZ L
  2439   "RTN","RCB EADJ1",13, 0)
  2440    ; Set DEB TOR value
  2441   "RTN","RCB EADJ1",14, 0)
  2442    S DEBTOR= RCBILLDA_" ;PRCA(430, "
  2443   "RTN","RCB EADJ1",15, 0)
  2444    ; Check f or unproce ssed recei pts
  2445   "RTN","RCB EADJ1",16, 0)
  2446    S RCPEND= $$PENDPAY^ RCDPURET(D EBTOR)
  2447   "RTN","RCB EADJ1",17, 0)
  2448    ; Extract  receipt n umbers and  amounts p aid on ind ividual li nes for pe nding rece ipts
  2449   "RTN","RCB EADJ1",18, 0)
  2450    S RCRCPT= 0
  2451   "RTN","RCB EADJ1",19, 0)
  2452    F  S RCRC PT=$O(^TMP ($J,"RCDPU REC","PP", RCRCPT)) Q :'RCRCPT   D
  2453   "RTN","RCB EADJ1",20, 0)
  2454    . S RCRCP TN=$$GET1^ DIQ(344,RC RCPT_",",. 01) Q:RCRC PTN=""
  2455   "RTN","RCB EADJ1",21, 0)
  2456    . S RCPEN D("R",RCRC PTN)=0
  2457   "RTN","RCB EADJ1",22, 0)
  2458    . S RCTRA NDA=0
  2459   "RTN","RCB EADJ1",23, 0)
  2460    . F  S RC TRANDA=$O( ^TMP($J,"R CDPUREC"," PP",RCRCPT ,RCTRANDA) ) Q:'RCTRA NDA  D
  2461   "RTN","RCB EADJ1",24, 0)
  2462    . . S RCA MT=$P($G(^ TMP($J,"RC DPUREC","P P",RCRCPT, RCTRANDA)) ,U,4) Q:+R CAMT=0
  2463   "RTN","RCB EADJ1",25, 0)
  2464    . . ; Sav e paid amo unt for th is claim o n this rec eipt
  2465   "RTN","RCB EADJ1",26, 0)
  2466    . . S RCP END("R",RC RCPTN)=RCP END("R",RC RCPTN)+RCA MT
  2467   "RTN","RCB EADJ1",27, 0)
  2468    . . ; Get  trace num ber for ER A
  2469   "RTN","RCB EADJ1",28, 0)
  2470    . . S RCE RA=$$GET1^ DIQ(344,RC RCPT_",",. 18,"I")
  2471   "RTN","RCB EADJ1",29, 0)
  2472    . . S RCT RACE=$S(RC ERA:$$GET1 ^DIQ(344.4 ,RCERA_"," ,.02,"I"), 1:"No Trac e Number")
  2473   "RTN","RCB EADJ1",30, 0)
  2474    . . ; Sav e trace nu mber
  2475   "RTN","RCB EADJ1",31, 0)
  2476    . . S RCP END("R",RC RCPTN,"T") =RCTRACE
  2477   "RTN","RCB EADJ1",32, 0)
  2478    ; Clear ^ TMP array  returned b y $$PENDPA Y
  2479   "RTN","RCB EADJ1",33, 0)
  2480    K ^TMP($J ,"RCDPUREC ","PP")
  2481   "RTN","RCB EADJ1",34, 0)
  2482    ; Find EE OB's for t his claim
  2483   "RTN","RCB EADJ1",35, 0)
  2484    S RCEOB=0
  2485   "RTN","RCB EADJ1",36, 0)
  2486    F  S RCEO B=$O(^IBM( 361.1,"B", RCBILLDA,R CEOB)) Q:' RCEOB  D
  2487   "RTN","RCB EADJ1",37, 0)
  2488    . ;Find E RAs for th is EOB - m ay be mult iple
  2489   "RTN","RCB EADJ1",38, 0)
  2490    . S RCERA =0
  2491   "RTN","RCB EADJ1",39, 0)
  2492    . F  S RC ERA=$O(^RC Y(344.4,"A DET",RCEOB ,RCERA)) Q :'RCERA  D
  2493   "RTN","RCB EADJ1",40, 0)
  2494    . . ; Ign ore ERA wh ich alread y has a re ceipt - pr ocessed or  otherwise
  2495   "RTN","RCB EADJ1",41, 0)
  2496    . . I $$G ET1^DIQ(34 4.4,RCERA_ ",",.08,"I ") Q
  2497   "RTN","RCB EADJ1",42, 0)
  2498    . . ; Get  ERA lines  for this  EOB
  2499   "RTN","RCB EADJ1",43, 0)
  2500    . . S RCL INE=0,RCTO T=0
  2501   "RTN","RCB EADJ1",44, 0)
  2502    . . F  S  RCLINE=$O( ^RCY(344.4 ,"ADET",RC EOB,RCERA, RCLINE)) Q :'RCLINE   D
  2503   "RTN","RCB EADJ1",45, 0)
  2504    . . . ; G et paid am ount from  ERA line
  2505   "RTN","RCB EADJ1",46, 0)
  2506    . . . S R CPAID=$$GE T1^DIQ(344 .41,RCLINE _","_RCERA _",",.03)
  2507   "RTN","RCB EADJ1",47, 0)
  2508    . . . ; I gnore zero  lines
  2509   "RTN","RCB EADJ1",48, 0)
  2510    . . . Q:' RCPAID
  2511   "RTN","RCB EADJ1",49, 0)
  2512    . . . ; I f no scrat chpad use  paid amoun t from ERA  - does no t take int o account  ERA level  adjustment s
  2513   "RTN","RCB EADJ1",50, 0)
  2514    . . . I ' $D(^RCY(34 4.49,RCERA )) S RCTOT =RCTOT+RCP AID Q
  2515   "RTN","RCB EADJ1",51, 0)
  2516    . . . ; F ind ERA li ne in scra tchpad
  2517   "RTN","RCB EADJ1",52, 0)
  2518    . . . S R CZL=$$FIND (RCERA,RCL INE) Q:'RC ZL
  2519   "RTN","RCB EADJ1",53, 0)
  2520    . . . ; I f scratchp ad exists  scan B ind ex for spl it lines(3 44.49 is D INUM with  344.4)
  2521   "RTN","RCB EADJ1",54, 0)
  2522    . . . S R CSUB=RCZL
  2523   "RTN","RCB EADJ1",55, 0)
  2524    . . . F   S RCSUB=$O (^RCY(344. 49,RCERA,1 ,"B",RCSUB )) Q:(RCSU B\1)'=RCZL   D
  2525   "RTN","RCB EADJ1",56, 0)
  2526    . . . . S  RCZ=$O(^R CY(344.49, RCERA,1,"B ",RCSUB,"" )) Q:'RCZ
  2527   "RTN","RCB EADJ1",57, 0)
  2528    . . . . ;  Check AR  BILL is fo r this cla im
  2529   "RTN","RCB EADJ1",58, 0)
  2530    . . . . Q :$$GET1^DI Q(344.491, RCZ_","_RC ERA_",",.0 7,"I")'=RC BILLDA
  2531   "RTN","RCB EADJ1",59, 0)
  2532    . . . . ;  Add AMOUN T TO POST  ON RECEIPT  to pendin g total -  should res olve rever sals
  2533   "RTN","RCB EADJ1",60, 0)
  2534    . . . . S  RCTOT=RCT OT+$$GET1^ DIQ(344.49 1,RCZ_","_ RCERA_",", .03)
  2535   "RTN","RCB EADJ1",61, 0)
  2536    . . ; If  claim tota l for the  ERA is zer o do not s ave trace  number and  paid amou nt
  2537   "RTN","RCB EADJ1",62, 0)
  2538    . . Q:RCT OT=0
  2539   "RTN","RCB EADJ1",63, 0)
  2540    . . ; Oth erwise get  trace num ber
  2541   "RTN","RCB EADJ1",64, 0)
  2542    . . S RCT RACE=$$GET 1^DIQ(344. 4,RCERA_", ",.02,"I")
  2543   "RTN","RCB EADJ1",65, 0)
  2544    . . S RCP END=RCPEND +RCTOT
  2545   "RTN","RCB EADJ1",66, 0)
  2546    . . ; Sav e totals b y ERA
  2547   "RTN","RCB EADJ1",67, 0)
  2548    . . S RCP END("E",RC ERA)=RCTOT ,RCPEND("E ",RCERA,"T ")=$S(RCTR ACE'="":RC TRACE,1:"N o Trace Nu mber")
  2549   "RTN","RCB EADJ1",68, 0)
  2550    Q:'RCPEND
  2551   "RTN","RCB EADJ1",69, 0)
  2552    W !!,"War ning - Pen ding Payme nts of $"_ $J(RCPEND, 0,2)_" exi st."
  2553   "RTN","RCB EADJ1",70, 0)
  2554    ; List un processed  receipts
  2555   "RTN","RCB EADJ1",71, 0)
  2556    S RCRCPTN =""
  2557   "RTN","RCB EADJ1",72, 0)
  2558    F  S RCRC PTN=$O(RCP END("R",RC RCPTN)) Q: RCRCPTN=""   W !,"Rcp t: ",RCRCP TN,?16,$J( "$"_$J(RCP END("R",RC RCPTN),0,2 ),11),?29, $G(RCPEND( "R",RCRCPT N,"T"))
  2559   "RTN","RCB EADJ1",73, 0)
  2560    ; List un processed  EOB
  2561   "RTN","RCB EADJ1",74, 0)
  2562    S RCERA=" "
  2563   "RTN","RCB EADJ1",75, 0)
  2564    F  S RCER A=$O(RCPEN D("E",RCER A)) Q:'RCE RA  W !,"E RA : ",RCE RA,?16,$J( "$"_$J(RCP END("E",RC ERA),0,2), 11),?29,$G (RCPEND("E ",RCERA,"T "))
  2565   "RTN","RCB EADJ1",76, 0)
  2566    Q
  2567   "RTN","RCB EADJ1",77, 0)
  2568    ;
  2569   "RTN","RCB EADJ1",78, 0)
  2570   FIND(RCERA ,RCLINE) ;  Search OR IGINAL ERA  SEQUENCES  for this  line
  2571   "RTN","RCB EADJ1",79, 0)
  2572    ; Input R CERA - Scr atchpad IE
  2573   "RTN","RCB EADJ1",80, 0)
  2574    ;       R CLINE - ER A line to  find
  2575   "RTN","RCB EADJ1",81, 0)
  2576    ; Output  RET - Scra tchpad lin e number
  2577   "RTN","RCB EADJ1",82, 0)
  2578    ;
  2579   "RTN","RCB EADJ1",83, 0)
  2580    N DA,ORIG ,RCSUB,RET
  2581   "RTN","RCB EADJ1",84, 0)
  2582    S RCSUB=0 ,RET=0
  2583   "RTN","RCB EADJ1",85, 0)
  2584    F  S RCSU B=$O(^RCY( 344.49,RCE RA,1,"ASEQ ",RCSUB))  Q:RET  Q:' RCSUB  D
  2585   "RTN","RCB EADJ1",86, 0)
  2586    . S DA=$O (^RCY(344. 49,RCERA,1 ,"ASEQ",RC SUB,"")) Q :'DA
  2587   "RTN","RCB EADJ1",87, 0)
  2588    . ;Get Or iginal seq uences
  2589   "RTN","RCB EADJ1",88, 0)
  2590    . S ORIG= $$GET1^DIQ (344.491,D A_","_RCER A_",",.09)  Q:ORIG=""
  2591   "RTN","RCB EADJ1",89, 0)
  2592    . ;Check  if scratch pad line i s for orig inal ERA l ine
  2593   "RTN","RCB EADJ1",90, 0)
  2594    . S ORIG= ","_ORIG_" ,"
  2595   "RTN","RCB EADJ1",91, 0)
  2596    . S:$F(OR IG,","_RCL INE_",") R ET=RCSUB
  2597   "RTN","RCB EADJ1",92, 0)
  2598    Q RET
  2599   "RTN","RCB EUTRA")
  2600   0^28^B3099 8596
  2601   "RTN","RCB EUTRA",1,0 )
  2602   RCBEUTRA ; WISC/RFJ-u tilties fo r transact ions (in f ile 433)            ; 1 Jun 00
  2603   "RTN","RCB EUTRA",2,0 )
  2604    ;;4.5;Acc ounts Rece ivable;**1 53,169,204 ,326,332** ;Mar 20, 1 995;Build  34
  2605   "RTN","RCB EUTRA",3,0 )
  2606    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  2607   "RTN","RCB EUTRA",4,0 )
  2608    Q
  2609   "RTN","RCB EUTRA",5,0 )
  2610    ;
  2611   "RTN","RCB EUTRA",6,0 )
  2612    ;
  2613   "RTN","RCB EUTRA",7,0 )
  2614   ADD433(BIL LDA,TRANTY PE) ;  add  a new tra nsaction t o file 433  (silent)
  2615   "RTN","RCB EUTRA",8,0 )
  2616    ;  return : ien of 4 33 transac tion or 0^ error msg
  2617   "RTN","RCB EUTRA",9,0 )
  2618    ;         : ^prca(43 3,ien) wil l be locke d if entry  selected
  2619   "RTN","RCB EUTRA",10, 0)
  2620    ; Input -  optional  variable R CDUZ for t he process ed by user . SET in ^ RCDPEAP fr om MARKED  FOR AUTOPO ST USER. P RCA*4.5*32
  2621   "RTN","RCB EUTRA",11, 0)
  2622    N %I,DA,D ATA0,DD,DI C,DICR,DIE ,DINUM,DIW ,DLAYGO,DO ,I,RCTRAND A,REFCODE, X,Y
  2623   "RTN","RCB EUTRA",12, 0)
  2624    ;
  2625   "RTN","RCB EUTRA",13, 0)
  2626    ;  find n ext availa ble transa ction numb er
  2627   "RTN","RCB EUTRA",14, 0)
  2628    ;  add an  extra lev el of lock s, some op erating sy stems do n ot process
  2629   "RTN","RCB EUTRA",15, 0)
  2630    ;  the lo cks correc tly if the y happen a t the same  time.
  2631   "RTN","RCB EUTRA",16, 0)
  2632    L +^PRCA( 433,"ADDNE WENTRY"):D ILOCKTM
  2633   "RTN","RCB EUTRA",17, 0)
  2634    I '$T Q " 0^Another  user is ad ding an AR  Transacti on, please  try again  later."
  2635   "RTN","RCB EUTRA",18, 0)
  2636    ;  start  with last  entry in f ile
  2637   "RTN","RCB EUTRA",19, 0)
  2638    ;    -> i f no data  is in the  entry, loc k it
  2639   "RTN","RCB EUTRA",20, 0)
  2640    ;       - > if the l ock works  and no dat a was adde d (prior t o the lock )
  2641   "RTN","RCB EUTRA",21, 0)
  2642    ;           -> then  you have t he entry.
  2643   "RTN","RCB EUTRA",22, 0)
  2644    ;           -> other wise, unlo ck it and  start over
  2645   "RTN","RCB EUTRA",23, 0)
  2646    F DINUM=$ P(^PRCA(43 3,0),"^",3 )+1:1 I '$ D(^PRCA(43 3,DINUM))  L +^PRCA(4 33,DINUM): DILOCKTM Q :$T&('$D(^ PRCA(433,D INUM)))  L  -^PRCA(43 3,DINUM)
  2647   "RTN","RCB EUTRA",24, 0)
  2648    L -^PRCA( 433,"ADDNE WENTRY")
  2649   "RTN","RCB EUTRA",25, 0)
  2650    ;
  2651   "RTN","RCB EUTRA",26, 0)
  2652    ;  add en try to fil e
  2653   "RTN","RCB EUTRA",27, 0)
  2654    S RCTRAND A=DINUM,(D IC,DIE)="^ PRCA(433," ,DIC(0)="L ",DLAYGO=4 33,X=DINUM
  2655   "RTN","RCB EUTRA",28, 0)
  2656    ;  build  DR string,  42=proces sed by (us e postmast er if queu ed)
  2657   "RTN","RCB EUTRA",29, 0)
  2658    S DIC("DR ")="42//// "_$S($G(RC DUZ):RCDUZ ,$D(ZTQUEU ED):.5,1:D UZ)_";" ;  PRCA*4.5*3 26 Use RCD UZ if defi ned
  2659   "RTN","RCB EUTRA",30, 0)
  2660    S DIC("DR ")=DIC("DR ")_".03/// /"_BILLDA_ ";"  ;bill  ien
  2661   "RTN","RCB EUTRA",31, 0)
  2662    S DIC("DR ")=DIC("DR ")_"12//// "_TRANTYPE _";" ;tran saction ty pe
  2663   "RTN","RCB EUTRA",32, 0)
  2664    S DATA0=$ G(^PRCA(43 0,BILLDA,0 ))
  2665   "RTN","RCB EUTRA",33, 0)
  2666    ;  approp riation sy mbol
  2667   "RTN","RCB EUTRA",34, 0)
  2668    I $P(DATA 0,"^",18)' ="" S DIC( "DR")=DIC( "DR")_"8// //"_$P(DAT A0,"^",18) _";"
  2669   "RTN","RCB EUTRA",35, 0)
  2670    ;  segmen t
  2671   "RTN","RCB EUTRA",36, 0)
  2672    I $P(DATA 0,"^",21)' ="" S DIC( "DR")=DIC( "DR")_"6// //"_$P(DAT A0,"^",21) _";"
  2673   "RTN","RCB EUTRA",37, 0)
  2674    ;  test f or referra l code
  2675   "RTN","RCB EUTRA",38, 0)
  2676    S REFCODE =$P($G(^PR CA(430,BIL LDA,6)),"^ ",5)
  2677   "RTN","RCB EUTRA",39, 0)
  2678    I REFCODE '="" S REF CODE=$S(RE FCODE="DC" :"RC",1:RE FCODE),DIC ("DR")=DIC ("DR")_"7/ ///"_REFCO DE_";"
  2679   "RTN","RCB EUTRA",40, 0)
  2680    ;  file i t
  2681   "RTN","RCB EUTRA",41, 0)
  2682    D FILE^DI CN
  2683   "RTN","RCB EUTRA",42, 0)
  2684    I Y=-1 L  -^PRCA(433 ,RCTRANDA)  Q "0^UNAB LE TO ADD  A NEW ENTR Y TO FILE  433"
  2685   "RTN","RCB EUTRA",43, 0)
  2686    Q RCTRAND A
  2687   "RTN","RCB EUTRA",44, 0)
  2688    ;
  2689   "RTN","RCB EUTRA",45, 0)
  2690    ;
  2691   "RTN","RCB EUTRA",46, 0)
  2692   FY433(RCTR ANDA) ;  t ransfer fi scal year  multiple f rom 430 to  433
  2693   "RTN","RCB EUTRA",47, 0)
  2694    ;  bill n umber must  be stored  in file 4 33, field  .03 before  calling
  2695   "RTN","RCB EUTRA",48, 0)
  2696    N BILLDA, FY,FYDATA
  2697   "RTN","RCB EUTRA",49, 0)
  2698    S BILLDA= +$P($G(^PR CA(433,RCT RANDA,0)), "^",2) I ' BILLDA Q
  2699   "RTN","RCB EUTRA",50, 0)
  2700    K ^PRCA(4 33,RCTRAND A,4)
  2701   "RTN","RCB EUTRA",51, 0)
  2702    S FY=0 F   S FY=$O(^ PRCA(430,B ILLDA,2,FY )) Q:'FY   D
  2703   "RTN","RCB EUTRA",52, 0)
  2704    .   S FYD ATA=$G(^PR CA(430,BIL LDA,2,FY,0 )) I $P(FY DATA,"^")= "" Q
  2705   "RTN","RCB EUTRA",53, 0)
  2706    .   S ^PR CA(433,RCT RANDA,4,FY ,0)=$P(FYD ATA,"^",1, 3)_"^1"
  2707   "RTN","RCB EUTRA",54, 0)
  2708    .   S ^PR CA(433,RCT RANDA,4,"B ",$P(FYDAT A,"^"),FY) =""
  2709   "RTN","RCB EUTRA",55, 0)
  2710    ;
  2711   "RTN","RCB EUTRA",56, 0)
  2712    S ^PRCA(4 33,RCTRAND A,4,0)="^4 33.01I^"_$ P($G(^PRCA (430,BILLD A,2,0)),"^ ",3,4)
  2713   "RTN","RCB EUTRA",57, 0)
  2714    Q
  2715   "RTN","RCB EUTRA",58, 0)
  2716    ;
  2717   "RTN","RCB EUTRA",59, 0)
  2718    ;
  2719   "RTN","RCB EUTRA",60, 0)
  2720   FYMULT(RCT RANDA) ;   apply paym ent to fy  multiple,  oldest fir st
  2721   "RTN","RCB EUTRA",61, 0)
  2722    N AMOUNT, FYDA,FYAMO UNT
  2723   "RTN","RCB EUTRA",62, 0)
  2724    ;  transf er fy mult iple if no t there
  2725   "RTN","RCB EUTRA",63, 0)
  2726    I '$D(^PR CA(433,RCT RANDA,4))  D FY433(RC TRANDA)
  2727   "RTN","RCB EUTRA",64, 0)
  2728    ;  amount  is princi pal amount
  2729   "RTN","RCB EUTRA",65, 0)
  2730    S AMOUNT= $P($$TRANV ALU^RCDPBT LM(RCTRAND A),"^",2)  I 'AMOUNT  Q
  2731   "RTN","RCB EUTRA",66, 0)
  2732    ;
  2733   "RTN","RCB EUTRA",67, 0)
  2734    ;  the tr ansaction  value is m inus, decr ease princ ipal
  2735   "RTN","RCB EUTRA",68, 0)
  2736    I AMOUNT< 0 D  Q
  2737   "RTN","RCB EUTRA",69, 0)
  2738    .   S AMO UNT=-AMOUN T
  2739   "RTN","RCB EUTRA",70, 0)
  2740    .   S FYD A=0 F  S F YDA=$O(^PR CA(433,RCT RANDA,4,FY DA)) Q:'FY DA  D  I ' AMOUNT Q
  2741   "RTN","RCB EUTRA",71, 0)
  2742    .   .   S  FYAMOUNT= $P($G(^PRC A(433,RCTR ANDA,4,FYD A,0)),"^", 2)
  2743   "RTN","RCB EUTRA",72, 0)
  2744    .   .   ;   fy amoun t is great er than tr ansaction  amount
  2745   "RTN","RCB EUTRA",73, 0)
  2746    .   .   I  FYAMOUNT> AMOUNT D   Q
  2747   "RTN","RCB EUTRA",74, 0)
  2748    .   .   .    S $P(^P RCA(433,RC TRANDA,4,F YDA,0),"^" ,2)=FYAMOU NT-AMOUNT
  2749   "RTN","RCB EUTRA",75, 0)
  2750    .   .   .    S $P(^P RCA(433,RC TRANDA,4,F YDA,0),"^" ,5)=AMOUNT
  2751   "RTN","RCB EUTRA",76, 0)
  2752    .   .   .    S AMOUN T=0
  2753   "RTN","RCB EUTRA",77, 0)
  2754    .   .   ;   fy amoun t not grea ter than t otal amoun t
  2755   "RTN","RCB EUTRA",78, 0)
  2756    .   .   S  $P(^PRCA( 433,RCTRAN DA,4,FYDA, 0),"^",2)= 0
  2757   "RTN","RCB EUTRA",79, 0)
  2758    .   .   S  $P(^PRCA( 433,RCTRAN DA,4,FYDA, 0),"^",5)= FYAMOUNT
  2759   "RTN","RCB EUTRA",80, 0)
  2760    .   .   S  AMOUNT=AM OUNT-FYAMO UNT
  2761   "RTN","RCB EUTRA",81, 0)
  2762    .   ;  mo ve back to  430
  2763   "RTN","RCB EUTRA",82, 0)
  2764    .   D FYM ULT^RCBEUB IL(RCTRAND A)
  2765   "RTN","RCB EUTRA",83, 0)
  2766    ;
  2767   "RTN","RCB EUTRA",84, 0)
  2768    ;  the tr ansaction  value is p lus, incre ase princi pal
  2769   "RTN","RCB EUTRA",85, 0)
  2770    S FYDA=$O (^PRCA(433 ,RCTRANDA, 4,999),-1)  I 'FYDA Q
  2771   "RTN","RCB EUTRA",86, 0)
  2772    S $P(^PRC A(433,RCTR ANDA,4,FYD A,0),"^",2 )=$P(^PRCA (433,RCTRA NDA,4,FYDA ,0),"^",2) +AMOUNT
  2773   "RTN","RCB EUTRA",87, 0)
  2774    S $P(^PRC A(433,RCTR ANDA,4,FYD A,0),"^",5 )=AMOUNT
  2775   "RTN","RCB EUTRA",88, 0)
  2776    ;  move b ack to 430
  2777   "RTN","RCB EUTRA",89, 0)
  2778    D FYMULT^ RCBEUBIL(R CTRANDA)
  2779   "RTN","RCB EUTRA",90, 0)
  2780    Q
  2781   "RTN","RCB EUTRA",91, 0)
  2782    ;
  2783   "RTN","RCB EUTRA",92, 0)
  2784    ;
  2785   "RTN","RCB EUTRA",93, 0)
  2786   EDIT433(RC TRANDA,DR)  ;  edit t he field i n 433 with  the DR st ring passe d
  2787   "RTN","RCB EUTRA",94, 0)
  2788    I '$D(^PR CA(433,RCT RANDA)) Q
  2789   "RTN","RCB EUTRA",95, 0)
  2790    N %,D,D0, D1,DA,DDH, DI,DIC,DIE ,DQ,J,X,Y
  2791   "RTN","RCB EUTRA",96, 0)
  2792    S (DIC,DI E)="^PRCA( 433,",DA=R CTRANDA
  2793   "RTN","RCB EUTRA",97, 0)
  2794    D ^DIE
  2795   "RTN","RCB EUTRA",98, 0)
  2796    ;  user p ressed up- arrow
  2797   "RTN","RCB EUTRA",99, 0)
  2798    I $D(Y) Q  "0^TRANSA CTION NOT  COMPLETELY  PROCESSED "
  2799   "RTN","RCB EUTRA",100 ,0)
  2800    Q 1
  2801   "RTN","RCB EUTRA",101 ,0)
  2802    ;
  2803   "RTN","RCB EUTRA",102 ,0)
  2804    ;
  2805   "RTN","RCB EUTRA",103 ,0)
  2806   PROCESS(RC TRANDA) ;   mark tran saction as  processed
  2807   "RTN","RCB EUTRA",104 ,0)
  2808    I '$D(^PR CA(433,RCT RANDA,0))  Q
  2809   "RTN","RCB EUTRA",105 ,0)
  2810    N D,D0,DA ,DI,DIC,DI E,DQ,DR,X, Y
  2811   "RTN","RCB EUTRA",106 ,0)
  2812    S (DIC,DI E)="^PRCA( 433,",DA=R CTRANDA
  2813   "RTN","RCB EUTRA",107 ,0)
  2814    S DR="3// //0;4////2 ;"
  2815   "RTN","RCB EUTRA",108 ,0)
  2816    D ^DIE
  2817   "RTN","RCB EUTRA",109 ,0)
  2818    Q
  2819   "RTN","RCB EUTRA",110 ,0)
  2820    ;
  2821   "RTN","RCB EUTRA",111 ,0)
  2822    ;
  2823   "RTN","RCB EUTRA",112 ,0)
  2824   INCOMPLE(R CTRANDA) ;   opposite  of proces sed, make  a transact ion incomp lete
  2825   "RTN","RCB EUTRA",113 ,0)
  2826    I '$D(^PR CA(433,RCT RANDA,0))  Q
  2827   "RTN","RCB EUTRA",114 ,0)
  2828    N D,D0,DA ,DI,DIC,DI E,DQ,DR,X, Y
  2829   "RTN","RCB EUTRA",115 ,0)
  2830    S (DIC,DI E)="^PRCA( 433,",DA=R CTRANDA
  2831   "RTN","RCB EUTRA",116 ,0)
  2832    S DR="4// //1;"
  2833   "RTN","RCB EUTRA",117 ,0)
  2834    D ^DIE
  2835   "RTN","RCB EUTRA",118 ,0)
  2836    Q
  2837   "RTN","RCB EUTRA",119 ,0)
  2838    ;
  2839   "RTN","RCB EUTRA",120 ,0)
  2840    ;
  2841   "RTN","RCB EUTRA",121 ,0)
  2842   DEL433(RCT RANDA,COMM ENT,ARCHIV E) ;  dele te (mark i ncomplete)  in file 4 33
  2843   "RTN","RCB EUTRA",122 ,0)
  2844    ;  commen t is the u ser commen t in field  41 (defau lt USER CA NCELLED)
  2845   "RTN","RCB EUTRA",123 ,0)
  2846    ;  archiv e is set t o 1 if cal led to arc hive trans action
  2847   "RTN","RCB EUTRA",124 ,0)
  2848    I '$D(^PR CA(433,RCT RANDA,0))  Q
  2849   "RTN","RCB EUTRA",125 ,0)
  2850    N %,D,D0, DA,DI,DIC, DIE,DQ,DR, J,RCBILLDA ,X,Y
  2851   "RTN","RCB EUTRA",126 ,0)
  2852    ;
  2853   "RTN","RCB EUTRA",127 ,0)
  2854    S (DIC,DI E)="^PRCA( 433,",DA=R CTRANDA
  2855   "RTN","RCB EUTRA",128 ,0)
  2856    ;  build  DR string
  2857   "RTN","RCB EUTRA",129 ,0)
  2858    S DR=""
  2859   "RTN","RCB EUTRA",130 ,0)
  2860    S DR=DR_" 4////1;"   ;transacti on status  incomplete
  2861   "RTN","RCB EUTRA",131 ,0)
  2862    S DR=DR_" 10////1;"  ;incomplet e transact ion flag
  2863   "RTN","RCB EUTRA",132 ,0)
  2864    S DR=DR_" 11///T;"   ;transacti on date
  2865   "RTN","RCB EUTRA",133 ,0)
  2866    I $G(COMM ENT)="" S  COMMENT="U SER CANCEL LED"
  2867   "RTN","RCB EUTRA",134 ,0)
  2868    S DR=DR_" 41///"_COM MENT_";"
  2869   "RTN","RCB EUTRA",135 ,0)
  2870    ;  brief  comment
  2871   "RTN","RCB EUTRA",136 ,0)
  2872    S RCBILLD A=$P($G(^P RCA(433,RC TRANDA,0)) ,"^",2)
  2873   "RTN","RCB EUTRA",137 ,0)
  2874    S DR=DR_" 5.02////SY STEM "_$S( $G(ARCHIVE ):"ARCHIVE D",1:"INAC TIVATED")_ $S(RCBILLD A:" (BILL  "_$P($G(^P RCA(430,RC BILLDA,0)) ,"^")_")", 1:"")_";"
  2875   "RTN","RCB EUTRA",138 ,0)
  2876    D ^DIE
  2877   "RTN","RCB EUTRA",139 ,0)
  2878    ;  since  the bill n umber (fie ld .03) is  required,  it must b e manually  removed
  2879   "RTN","RCB EUTRA",140 ,0)
  2880    I RCBILLD A S $P(^PR CA(433,RCT RANDA,0)," ^",2)="" K  ^PRCA(433 ,"C",RCBIL LDA,RCTRAN DA)
  2881   "RTN","RCB EUTRA",141 ,0)
  2882    ;  remove  fy multip le
  2883   "RTN","RCB EUTRA",142 ,0)
  2884    K ^PRCA(4 33,RCTRAND A,4)
  2885   "RTN","RCB EUTRA",143 ,0)
  2886    Q
  2887   "RTN","RCB EUTRA",144 ,0)
  2888    ;
  2889   "RTN","RCB EUTRA",145 ,0)
  2890    ;
  2891   "RTN","RCB EUTRA",146 ,0)
  2892   ADDCOMM(RC TRANDA,COM MENT) ;  a utomatical ly put a c omment on  a transact ion
  2893   "RTN","RCB EUTRA",147 ,0)
  2894    ;  commen t in the a rray comme nt(1)=firs t line
  2895   "RTN","RCB EUTRA",148 ,0)
  2896    ;                         comme nt(2)=seco nd line
  2897   "RTN","RCB EUTRA",149 ,0)
  2898    N CURRLIN E,LINE
  2899   "RTN","RCB EUTRA",150 ,0)
  2900    ;  get th e last lin e
  2901   "RTN","RCB EUTRA",151 ,0)
  2902    S CURRLIN E=$O(^PRCA (433,RCTRA NDA,7,9999 9999),-1)
  2903   "RTN","RCB EUTRA",152 ,0)
  2904    ;  if com ment alrea dy on tran saction, a dd a blank  line and
  2905   "RTN","RCB EUTRA",153 ,0)
  2906    ;  date t ime of new  comment
  2907   "RTN","RCB EUTRA",154 ,0)
  2908    I CURRLIN E D
  2909   "RTN","RCB EUTRA",155 ,0)
  2910    .   S CUR RLINE=CURR LINE+1,^PR CA(433,RCT RANDA,7,CU RRLINE,0)= " "
  2911   "RTN","RCB EUTRA",156 ,0)
  2912    .   S CUR RLINE=CURR LINE+1,^PR CA(433,RCT RANDA,7,CU RRLINE,0)= "Comment a dded on: " _$$FMTE^XL FDT($$NOW^ XLFDT)
  2913   "RTN","RCB EUTRA",157 ,0)
  2914    ;  add ne w lines
  2915   "RTN","RCB EUTRA",158 ,0)
  2916    F LINE=1: 1 Q:'$D(CO MMENT(LINE ))  S ^PRC A(433,RCTR ANDA,7,CUR RLINE+LINE ,0)=COMMEN T(LINE)
  2917   "RTN","RCB EUTRA",159 ,0)
  2918    ;  set th e 0th node
  2919   "RTN","RCB EUTRA",160 ,0)
  2920    S ^PRCA(4 33,RCTRAND A,7,0)="^^ "_(CURRLIN E+LINE-1)_ "^"_(CURRL INE+LINE-1 )_"^"_DT_" ^"
  2921   "RTN","RCB EUTRA",161 ,0)
  2922    Q
  2923   "RTN","RCB EUTRA",162 ,0)
  2924   FMSDATE(X)  ;Finds th e next mon th & year  and sets t he date fo r transmis sion
  2925   "RTN","RCB EUTRA",163 ,0)
  2926    ;of the d ocument to  FMS.  If  DT is afte r EOAM and  the docum ent has no t
  2927   "RTN","RCB EUTRA",164 ,0)
  2928    ;been pre viously tr ansmitted,  the date  will be se t to the f irst of th e
  2929   "RTN","RCB EUTRA",165 ,0)
  2930    ;next mon th.  If th e DT is af ter the EO AM and the  document  is being 
  2931   "RTN","RCB EUTRA",166 ,0)
  2932    ;re-trans mitted, th e the date  of transm ission wil l be DT. T he flag RE GEN
  2933   "RTN","RCB EUTRA",167 ,0)
  2934    ;is set i n the sour ce code if  the docum ent is bei ng 
  2935   "RTN","RCB EUTRA",168 ,0)
  2936    ;re-trans mitted, th us will ha ve a trans mission da te of DT.
  2937   "RTN","RCB EUTRA",169 ,0)
  2938    I $G(REFM S) G QUIT
  2939   "RTN","RCB EUTRA",170 ,0)
  2940    I DT>$$LD ATE^RCRJR( DT) S X=$E ($$FPS^RCA MFN01(X,1) ,1,5)_"01"
  2941   "RTN","RCB EUTRA",171 ,0)
  2942   QUIT Q X
  2943   "RTN","RCD PAYER")
  2944   0^44^B2682 6593
  2945   "RTN","RCD PAYER",1,0 )
  2946   RCDPAYER ; ALB/PJH -  TPJI Utili ty ;Jun 06 , 2014@19: 11:19
  2947   "RTN","RCD PAYER",2,0 )
  2948    ;;4.5;Acc ounts Rece ivable;**2 69,276,298 ,326,332** ;Mar 20, 1 995;Build  34
  2949   "RTN","RCD PAYER",3,0 )
  2950    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  2951   "RTN","RCD PAYER",4,0 )
  2952    ;
  2953   "RTN","RCD PAYER",5,0 )
  2954    ;Integrat ion Agreem ent 5549
  2955   "RTN","RCD PAYER",6,0 )
  2956    ;
  2957   "RTN","RCD PAYER",7,0 )
  2958    Q
  2959   "RTN","RCD PAYER",8,0 )
  2960    ;
  2961   "RTN","RCD PAYER",9,0 )
  2962   EN(IB3611)  ;Called f rom IBJTTC
  2963   "RTN","RCD PAYER",10, 0)
  2964    ; IB3611  = ien of E XPLANATION  OF BENEFI TS file (3 61.1)
  2965   "RTN","RCD PAYER",11, 0)
  2966    ; gathers  payer con tact data  from file  361.1 and  344.4
  2967   "RTN","RCD PAYER",12, 0)
  2968    ; returns  the data  to IBJTTC  for displa y on COMME NT HISTORY  screen of  TPJI
  2969   "RTN","RCD PAYER",13, 0)
  2970    N AR3444, CONTACTS,E RA3,FOUND, I,IBTEXT,I B25,STR,WE B,NAME
  2971   "RTN","RCD PAYER",14, 0)
  2972    ;
  2973   "RTN","RCD PAYER",15, 0)
  2974    S CONTACT S="",STR=" ",FOUND=0, WEB="",NAM E=""
  2975   "RTN","RCD PAYER",16, 0)
  2976    ;
  2977   "RTN","RCD PAYER",17, 0)
  2978    ;Retrieve  contacts  from EOB f ile
  2979   "RTN","RCD PAYER",18, 0)
  2980    S IB25=$P ($G(^IBM(3 61.1,IB361 1,25)),U,1 ,7) ;IA 40 51
  2981   "RTN","RCD PAYER",19, 0)
  2982    S:$TR(IB2 5,U,"")]""  FOUND=1,S TR=IB25
  2983   "RTN","RCD PAYER",20, 0)
  2984    ;
  2985   "RTN","RCD PAYER",21, 0)
  2986    ;Get ERA  reference
  2987   "RTN","RCD PAYER",22, 0)
  2988    S AR3444= $O(^RCY(34 4.4,"ADET" ,IB3611,"" ))
  2989   "RTN","RCD PAYER",23, 0)
  2990    ;
  2991   "RTN","RCD PAYER",24, 0)
  2992    ;If no co ntact in E OB retriev e contacts  from ERA  file
  2993   "RTN","RCD PAYER",25, 0)
  2994    I AR3444, 'FOUND D
  2995   "RTN","RCD PAYER",26, 0)
  2996    .S ERA3=$ P($G(^RCY( 344.4,AR34 44,3)),U,1 ,7)
  2997   "RTN","RCD PAYER",27, 0)
  2998    .S:$TR(ER A3,U,"")]" " FOUND=1, STR=ERA3
  2999   "RTN","RCD PAYER",28, 0)
  3000    ;
  3001   "RTN","RCD PAYER",29, 0)
  3002    ;Retrieve  Payer Web  Address f rom ERA fi le
  3003   "RTN","RCD PAYER",30, 0)
  3004    I AR3444  S WEB=$P($ G(^RCY(344 .4,AR3444, 5)),U) S:W EB]"" FOUN D=1
  3005   "RTN","RCD PAYER",31, 0)
  3006    ;
  3007   "RTN","RCD PAYER",32, 0)
  3008    ;Get Paye r Contact  Name
  3009   "RTN","RCD PAYER",33, 0)
  3010    S NAME=$P (STR,U) S: NAME]"" FO UND=1
  3011   "RTN","RCD PAYER",34, 0)
  3012    ;
  3013   "RTN","RCD PAYER",35, 0)
  3014    ;Format c ontacts
  3015   "RTN","RCD PAYER",36, 0)
  3016    I STR]""  D
  3017   "RTN","RCD PAYER",37, 0)
  3018    .N I,CTYP ,CPOS
  3019   "RTN","RCD PAYER",38, 0)
  3020    .F I=2,4, 6 D:$P(STR ,U,I)]""
  3021   "RTN","RCD PAYER",39, 0)
  3022    ..;Valida te contact  type
  3023   "RTN","RCD PAYER",40, 0)
  3024    ..S CTYP= $P(STR,U,I +1)
  3025   "RTN","RCD PAYER",41, 0)
  3026    ..S CPOS= $S(CTYP="T E":1,CTYP= "FX":2,CTY P="EM":3,C TYP="EX":4 ,1:0)
  3027   "RTN","RCD PAYER",42, 0)
  3028    ..Q:'CPOS
  3029   "RTN","RCD PAYER",43, 0)
  3030    ..;Save o nly first  occurance  of each ty pe of cont act
  3031   "RTN","RCD PAYER",44, 0)
  3032    ..S:$P(CO NTACTS,U,C POS)="" $P (CONTACTS, U,CPOS)=$P (STR,U,I)
  3033   "RTN","RCD PAYER",45, 0)
  3034    ;
  3035   "RTN","RCD PAYER",46, 0)
  3036    ;Allow fo r misfiled  legacy co ntact data
  3037   "RTN","RCD PAYER",47, 0)
  3038    I FOUND,N AME="",WEB ="",CONTAC TS="" S FO UND=0
  3039   "RTN","RCD PAYER",48, 0)
  3040    ;Return f ound_web_p hone_fax_e mail
  3041   "RTN","RCD PAYER",49, 0)
  3042    Q FOUND_U _NAME_U_WE B_U_CONTAC TS
  3043   "RTN","RCD PAYER",50, 0)
  3044    ;
  3045   "RTN","RCD PAYER",51, 0)
  3046   ADD(PRCABN ) ;Update  AR Transac tion file  #433 with  comment ty pe transac tion
  3047   "RTN","RCD PAYER",52, 0)
  3048    ;PRCABN =  Bill/Clai m IEN for  file #399.
  3049   "RTN","RCD PAYER",53, 0)
  3050    ;called o nly if 'ER A Contact  Informatio n' type co mment is n ot found
  3051   "RTN","RCD PAYER",54, 0)
  3052    ;serves a s a notice  to the us er that th e contact  data came  from the 8 35 ERA. Ca lled from  IBJTTC
  3053   "RTN","RCD PAYER",55, 0)
  3054    ;
  3055   "RTN","RCD PAYER",56, 0)
  3056    ;Note; PJ H 8/11/201 0 - see AD JUST^RCJIB FN3 (calle d by ARCA^ IBJTA1)
  3057   "RTN","RCD PAYER",57, 0)
  3058    ;
  3059   "RTN","RCD PAYER",58, 0)
  3060    N AUTHDT, IBIFN,MRAD T,STATUS
  3061   "RTN","RCD PAYER",59, 0)
  3062    S IBIFN=P RCABN
  3063   "RTN","RCD PAYER",60, 0)
  3064    S STATUS= $P($G(^DGC R(399,IBIF N,0)),U,13 )
  3065   "RTN","RCD PAYER",61, 0)
  3066    S AUTHDT= $P($G(^DGC R(399,IBIF N,"S")),U, 10)
  3067   "RTN","RCD PAYER",62, 0)
  3068    S MRADT=$ P($G(^DGCR (399,IBIFN ,"S")),U,7 )
  3069   "RTN","RCD PAYER",63, 0)
  3070    ;
  3071   "RTN","RCD PAYER",64, 0)
  3072    ;If claim  status is  "NOT REVI EWED" or c laim statu s is "CANC ELLED"
  3073   "RTN","RCD PAYER",65, 0)
  3074    ;with nei ther MRA r equest dat e nor Auth orization  date prese nt
  3075   "RTN","RCD PAYER",66, 0)
  3076    ;comment  may not be  added
  3077   "RTN","RCD PAYER",67, 0)
  3078    I STATUS= 1!(STATUS= 7&(MRADT=" ")&(AUTHDT ="")) Q
  3079   "RTN","RCD PAYER",68, 0)
  3080    ;
  3081   "RTN","RCD PAYER",69, 0)
  3082    ;If claim  status is  "REQUEST  MRA" or cl aim status  is "CANCE LLED"
  3083   "RTN","RCD PAYER",70, 0)
  3084    ;with MRA  request d ate presen t, but no  Authorizat ion date c omment
  3085   "RTN","RCD PAYER",71, 0)
  3086    ;cannot b e added
  3087   "RTN","RCD PAYER",72, 0)
  3088    I STATUS= 2!(STATUS= 7&(MRADT'= "")&(AUTHD T="")) Q
  3089   "RTN","RCD PAYER",73, 0)
  3090    ;
  3091   "RTN","RCD PAYER",74, 0)
  3092    ;Ignore b ill cancel led in IB
  3093   "RTN","RCD PAYER",75, 0)
  3094    I '$D(^PR CA(430,PRC ABN,2,0))  Q
  3095   "RTN","RCD PAYER",76, 0)
  3096    ;
  3097   "RTN","RCD PAYER",77, 0)
  3098    ;Ignore A rchived bi ll
  3099   "RTN","RCD PAYER",78, 0)
  3100    I $P($G(^ PRCA(430,P RCABN,0)), "^",8)=49  Q
  3101   "RTN","RCD PAYER",79, 0)
  3102    ;
  3103   "RTN","RCD PAYER",80, 0)
  3104    ;Build AR  Transacti on
  3105   "RTN","RCD PAYER",81, 0)
  3106    ;
  3107   "RTN","RCD PAYER",82, 0)
  3108    N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY
  3109   "RTN","RCD PAYER",83, 0)
  3110    ;
  3111   "RTN","RCD PAYER",84, 0)
  3112    ;Create s tub record  in 433
  3113   "RTN","RCD PAYER",85, 0)
  3114    D SETTR^P RCAUTL,PAT TR^PRCAUTL  Q:'$D(PRC AEN)
  3115   "RTN","RCD PAYER",86, 0)
  3116    ;
  3117   "RTN","RCD PAYER",87, 0)
  3118    S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
  3119   "RTN","RCD PAYER",88, 0)
  3120    Q:PRCAA1' >0  S PRCA A2=$P(^(0) ,U,3)
  3121   "RTN","RCD PAYER",89, 0)
  3122    ;
  3123   "RTN","RCD PAYER",90, 0)
  3124    ;Direct u pdate of [ PRCA COMME NT] edit t emplate fi elds 
  3125   "RTN","RCD PAYER",91, 0)
  3126    ;(excludi ng Date of  Contact,  Extended C omments an d Follow-u p Date)
  3127   "RTN","RCD PAYER",92, 0)
  3128    S DIE="^P RCA(433,", DA=PRCAEN
  3129   "RTN","RCD PAYER",93, 0)
  3130    S DR=".03 ////"_PRCA BN ;Bill N umber
  3131   "RTN","RCD PAYER",94, 0)
  3132    S DR=DR_" ;3////0" ; Calm Code  Done
  3133   "RTN","RCD PAYER",95, 0)
  3134    S DR=DR_" ;12////"_$ O(^PRCA(43 0.3,"AC",1 7,0)) ;Tra nsaction T ype
  3135   "RTN","RCD PAYER",96, 0)
  3136    S DR=DR_" ;15////0"  ;Transacti on Amount
  3137   "RTN","RCD PAYER",97, 0)
  3138    S DR=DR_" ;42////.5"  ;Processe d by POSTM ASTER
  3139   "RTN","RCD PAYER",98, 0)
  3140    S DR=DR_" ;4////2" ; Transactio n status ( complete)
  3141   "RTN","RCD PAYER",99, 0)
  3142    S DR=DR_" ;5.02////E RA Payer C ontact Inf ormation"  D ^DIE
  3143   "RTN","RCD PAYER",100 ,0)
  3144    ;
  3145   "RTN","RCD PAYER",101 ,0)
  3146    ;Leave va lidation c hecks in p lace
  3147   "RTN","RCD PAYER",102 ,0)
  3148    I $P($G(^ PRCA(433,P RCAEN,5)), "^",2)=""! '$P(^PRCA( 433,PRCAEN ,1),"^") S  PRCACOMM= "TRANSACTI ON INCOMPL ETE" D DEL ETE^PRCAWO 1 K PRCACO MM Q
  3149   "RTN","RCD PAYER",103 ,0)
  3150    ;
  3151   "RTN","RCD PAYER",104 ,0)
  3152    I '$D(PRC AD("DELETE ")) S RCAS K=1 D TRAN UP^PRCAUTL ,UPPRIN^PR CADJ
  3153   "RTN","RCD PAYER",105 ,0)
  3154    ;
  3155   "RTN","RCD PAYER",106 ,0)
  3156    I $P($G(^ RCD(340,+$ P(^PRCA(43 0,PRCABN,0 ),"^",9),0 )),"^")["; DPT(" D
  3157   "RTN","RCD PAYER",107 ,0)
  3158    .;Ensure  comment do es not app ear on pat ient state ment
  3159   "RTN","RCD PAYER",108 ,0)
  3160    .S $P(^PR CA(433,PRC AEN,0),"^" ,10)=1
  3161   "RTN","RCD PAYER",109 ,0)
  3162    Q
  3163   "RTN","RCD PAYER",110 ,0)
  3164    ;
  3165   "RTN","RCD PAYER",111 ,0)
  3166    ;Audit Co mment from  EOB Move/ Copy
  3167   "RTN","RCD PAYER",112 ,0)
  3168   AUDIT(ORIG ,TEXT,MODE ) ;
  3169   "RTN","RCD PAYER",113 ,0)
  3170    ; ORIG =  ien of ent ry in 361. 1
  3171   "RTN","RCD PAYER",114 ,0)
  3172    ; TEXT =  move/copy  reason
  3173   "RTN","RCD PAYER",115 ,0)
  3174    ; MODE =  is this a  move or a  copy event
  3175   "RTN","RCD PAYER",116 ,0)
  3176    ;
  3177   "RTN","RCD PAYER",117 ,0)
  3178    ;Translat e EOB ien   to claim  number IA  4051
  3179   "RTN","RCD PAYER",118 ,0)
  3180    N PRCABN
  3181   "RTN","RCD PAYER",119 ,0)
  3182    S PRCABN= $P($G(^IBM (361.1,ORI G,0)),U) Q :'PRCABN
  3183   "RTN","RCD PAYER",120 ,0)
  3184    ;Build AR  Transacti on
  3185   "RTN","RCD PAYER",121 ,0)
  3186    ;
  3187   "RTN","RCD PAYER",122 ,0)
  3188    N PRCAEN, PRCAA1,DR, DIE,DA,D0, PRCAD,RCAS K,PRCAA2,P RCA,PRCATY
  3189   "RTN","RCD PAYER",123 ,0)
  3190    ;
  3191   "RTN","RCD PAYER",124 ,0)
  3192    ;Create s tub record  in 433
  3193   "RTN","RCD PAYER",125 ,0)
  3194    D SETTR^P RCAUTL,PAT TR^PRCAUTL  Q:'$D(PRC AEN)
  3195   "RTN","RCD PAYER",126 ,0)
  3196    ;
  3197   "RTN","RCD PAYER",127 ,0)
  3198    S PRCAA1= $S($D(^PRC A(433,PRCA EN,4,0)):+ $P(^(0),U, 4),1:0)
  3199   "RTN","RCD PAYER",128 ,0)
  3200    Q:PRCAA1' >0  S PRCA A2=$P(^(0) ,U,3)
  3201   "RTN","RCD PAYER",129 ,0)
  3202    ;
  3203   "RTN","RCD PAYER",130 ,0)
  3204    N MTEXT,I NIT
  3205   "RTN","RCD PAYER",131 ,0)
  3206    S INIT=$$ GET1^DIQ(2 00,DUZ,1)
  3207   "RTN","RCD PAYER",132 ,0)
  3208    S:INIT=""  INIT="USE R UNK."
  3209   "RTN","RCD PAYER",133 ,0)
  3210    S MTEXT=" EEOB MOVED  BY "_INIT
  3211   "RTN","RCD PAYER",134 ,0)
  3212    I MODE="C " S MTEXT= "EEOB COPI ED BY "_IN IT
  3213   "RTN","RCD PAYER",135 ,0)
  3214    I MODE="R " S MTEXT= "EEOB REMO VED BY "_I NIT
  3215   "RTN","RCD PAYER",136 ,0)
  3216    I MODE="W " S MTEXT= "EEOB MOVE /COPY IN S PLIT/EDIT"
  3217   "RTN","RCD PAYER",137 ,0)
  3218    I MODE="L " S MTEXT= "EEOB MOVE /COPY IN L INK PAYMEN T"
  3219   "RTN","RCD PAYER",138 ,0)
  3220    ;Direct u pdate of [ PRCA COMME NT] edit t emplate fi elds 
  3221   "RTN","RCD PAYER",139 ,0)
  3222    ;(excludi ng Date of  Contact,  Extended C omments an d Follow-u p Date)
  3223   "RTN","RCD PAYER",140 ,0)
  3224    S DIE="^P RCA(433,", DA=PRCAEN
  3225   "RTN","RCD PAYER",141 ,0)
  3226    S DR=".03 ////"_PRCA BN ;Bill N umber
  3227   "RTN","RCD PAYER",142 ,0)
  3228    S DR=DR_" ;3////0" ; Calm Code  Done
  3229   "RTN","RCD PAYER",143 ,0)
  3230    S DR=DR_" ;12////"_$ O(^PRCA(43 0.3,"AC",1 7,0)) ;Tra nsaction T ype
  3231   "RTN","RCD PAYER",144 ,0)
  3232    S DR=DR_" ;15////0"  ;Transacti on Amount
  3233   "RTN","RCD PAYER",145 ,0)
  3234    S DR=DR_" ;42////"_$ S($G(RCDUZ ):RCDUZ,1: DUZ) ;Proc essed by -  PRCA*4.5* 326 use RC DUZ if it  is set
  3235   "RTN","RCD PAYER",146 ,0)
  3236    S DR=DR_" ;11////"_D T ;Transac tion date  ; PRCA*4.5 *332 - Fix  error int roduced in  previous  patch
  3237   "RTN","RCD PAYER",147 ,0)
  3238    S DR=DR_" ;4////2" ; Transactio n status ( complete)
  3239   "RTN","RCD PAYER",148 ,0)
  3240    S DR=DR_" ;5.02////" _MTEXT ;Br ief commen t
  3241   "RTN","RCD PAYER",149 ,0)
  3242    D ^DIE
  3243   "RTN","RCD PAYER",150 ,0)
  3244    ;Store ju stificatio n text in  comment fi eld
  3245   "RTN","RCD PAYER",151 ,0)
  3246    N DA,DIC, DLAYGO,DR, X
  3247   "RTN","RCD PAYER",152 ,0)
  3248    S DA(1)=P RCAEN
  3249   "RTN","RCD PAYER",153 ,0)
  3250    S DIC="^P RCA(433,"_ DA(1)_",7, ",DIC(0)=" L",X=$P(TE XT,U)
  3251   "RTN","RCD PAYER",154 ,0)
  3252    D FILE^DI CN
  3253   "RTN","RCD PAYER",155 ,0)
  3254    ;Store au to generat ed text fr om stand a lone optio n in comme nt field
  3255   "RTN","RCD PAYER",156 ,0)
  3256    I $P(TEXT ,U,2)]"" D
  3257   "RTN","RCD PAYER",157 ,0)
  3258    .N DA,DIC ,DLAYGO,DR ,X
  3259   "RTN","RCD PAYER",158 ,0)
  3260    .S DA(1)= PRCAEN
  3261   "RTN","RCD PAYER",159 ,0)
  3262    .S DIC="^ PRCA(433," _DA(1)_",7 ,",DIC(0)= "L",X="- " _$P(TEXT,U ,2)
  3263   "RTN","RCD PAYER",160 ,0)
  3264    .D FILE^D ICN
  3265   "RTN","RCD PAYER",161 ,0)
  3266    Q
  3267   "RTN","RCD PEAA3")
  3268   0^43^B1363 36924
  3269   "RTN","RCD PEAA3",1,0 )
  3270   RCDPEAA3 ; ALB/KML -  APAR Scree n - callab le entry p oints ;Nov  24, 2014@ 23:32:24
  3271   "RTN","RCD PEAA3",2,0 )
  3272    ;;4.5;Acc ounts Rece ivable;**2 98,304,318 ,332**;Mar  20, 1995; Build 34
  3273   "RTN","RCD PEAA3",3,0 )
  3274    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  3275   "RTN","RCD PEAA3",4,0 )
  3276    Q
  3277   "RTN","RCD PEAA3",5,0 )
  3278    ;
  3279   "RTN","RCD PEAA3",6,0 )
  3280   SPLIT(RCIE NS) ;EP -  Protocol a ction - RC DPE APAR S PLINE LINE
  3281   "RTN","RCD PEAA3",7,0 )
  3282    ; Split E EOB in APA R
  3283   "RTN","RCD PEAA3",8,0 )
  3284    ; Input:    RCIENS   - Internal  IEN of en try in fil e 344.49^i en of 
  3285   "RTN","RCD PEAA3",9,0 )
  3286    ;                      344.491^ selectable  line item  from list man screen
  3287   "RTN","RCD PEAA3",10, 0)
  3288    N DIR,L,R CQUIT,X
  3289   "RTN","RCD PEAA3",11, 0)
  3290    S RCQUIT= 0
  3291   "RTN","RCD PEAA3",12, 0)
  3292    D FULL^VA LM1
  3293   "RTN","RCD PEAA3",13, 0)
  3294    I '$D(^XU SEC("RCDPE PP",DUZ))  D  Q  ; PR CA*4.5*318  Added sec urity key  check
  3295   "RTN","RCD PEAA3",14, 0)
  3296    . S VALMB CK="R"
  3297   "RTN","RCD PEAA3",15, 0)
  3298    . W !!,"T his action  can only  be taken b y users th at have th e RCDPEPP  security k ey.",!
  3299   "RTN","RCD PEAA3",16, 0)
  3300    . D PAUSE ^VALM1
  3301   "RTN","RCD PEAA3",17, 0)
  3302    S L=0
  3303   "RTN","RCD PEAA3",18, 0)
  3304    F  S L=$O (^RCY(344. 49,$P(RCIE NS,U),1,$P (RCIENS,U, 2),1,L)) Q :'L  I "01 "[$P($G(^( L,0)),U,2)  D  G SPLI TQ
  3305   "RTN","RCD PEAA3",19, 0)
  3306    . S DIR(0 )="EA",DIR ("A",1)="T HIS EEOB I S NOT AVAI LABLE TO E DIT/SPLIT" ,DIR("A")= "PRESS RET URN TO CON TINUE "
  3307   "RTN","RCD PEAA3",20, 0)
  3308    . W ! D ^ DIR K DIR
  3309   "RTN","RCD PEAA3",21, 0)
  3310    I $P($G(^ RCY(344.49 ,$P(RCIENS ,U),1,$P(R CIENS,U,2) ,0)),U,13)  D  G:RCQU IT SPLITQ
  3311   "RTN","RCD PEAA3",22, 0)
  3312    . S DIR(" A",1)="WAR NING!  THI S LINE HAS  ALREADY B EEN VERIFI ED",DIR("A ")="ARE YO U SURE YOU  WANT TO C ONTINUE?:  ",DIR(0)=" YA",DIR("B ")="NO" W  ! D ^DIR K  DIR
  3313   "RTN","RCD PEAA3",23, 0)
  3314    . I Y'=1  S RCQUIT=1
  3315   "RTN","RCD PEAA3",24, 0)
  3316    K ^TMP("R CDPE_SPLIT _REBLD",$J )
  3317   "RTN","RCD PEAA3",25, 0)
  3318    S X=+$O(^ TMP("RCDPE -EOB_WLDX" ,$J,""),-1 )
  3319   "RTN","RCD PEAA3",26, 0)
  3320    D SPLIT^R CDPEWL3($P (RCIENS,U) ,X)
  3321   "RTN","RCD PEAA3",27, 0)
  3322    I $G(^TMP ("RCDPE_SP LIT_REBLD" ,$J)) K ^T MP("RCDPE_ SPLIT_REBL D",$J) D I NIT^RCDPEA A2(RCIENS)
  3323   "RTN","RCD PEAA3",28, 0)
  3324    ;
  3325   "RTN","RCD PEAA3",29, 0)
  3326   SPLITQ S V ALMBCK="R"
  3327   "RTN","RCD PEAA3",30, 0)
  3328    Q
  3329   "RTN","RCD PEAA3",31, 0)
  3330    ;
  3331   "RTN","RCD PEAA3",32, 0)
  3332   REFRESH(RC IENS) ;EP  - Protocol  action -  RCDPE APAR  EEOB REFR ESH - PRCA *4.5*332 s ubroutine  re-written
  3333   "RTN","RCD PEAA3",33, 0)
  3334    ; Refresh  the entry  in file 3 44.49 to r emove all  user adjus tments
  3335   "RTN","RCD PEAA3",34, 0)
  3336    ;  Input:   RCIENS   - Internal  IEN of en try in fil e 344.49^i en of 
  3337   "RTN","RCD PEAA3",35, 0)
  3338    ;                      344.491^ selectable  line item  from list man screen
  3339   "RTN","RCD PEAA3",36, 0)
  3340    N DA,DIK, DIR,DONE,I ENS,OSEQ,S EQ,X,XX,Y, Z,ZZ,Z0
  3341   "RTN","RCD PEAA3",37, 0)
  3342    D FULL^VA LM1
  3343   "RTN","RCD PEAA3",38, 0)
  3344    S XX=$P(R CIENS,"^", 2)_","_$P( RCIENS,"^" ,1)_","
  3345   "RTN","RCD PEAA3",39, 0)
  3346    S SEQ=$$G ET1^DIQ(34 4.491,XX,. 01,"I")        ; Line  Sequence  #
  3347   "RTN","RCD PEAA3",40, 0)
  3348    I '$D(^XU SEC("RCDPE PP",DUZ))  D  Q  ; PR CA*4.5*318  Added sec urity key  check
  3349   "RTN","RCD PEAA3",41, 0)
  3350    . S VALMB CK="R"
  3351   "RTN","RCD PEAA3",42, 0)
  3352    . W !!,"T his action  can only  be taken b y users th at have th e RCDPEPP  security k ey.",!
  3353   "RTN","RCD PEAA3",43, 0)
  3354    . D PAUSE ^VALM1
  3355   "RTN","RCD PEAA3",44, 0)
  3356    ;
  3357   "RTN","RCD PEAA3",45, 0)
  3358    S DIR(0)= "YA"
  3359   "RTN","RCD PEAA3",46, 0)
  3360    S DIR("A" ,1)="This  action wil l delete a nd rebuild  this EEOB  Worklist  Scratch Pa d for Line  "_SEQ_"."
  3361   "RTN","RCD PEAA3",47, 0)
  3362    S DIR("A" ,2)="All S plits/Edit s/Reviews  entered fo r this lin e will be  erased and  all entri es"
  3363   "RTN","RCD PEAA3",48, 0)
  3364    S DIR("A" ,3)="marke d as manua lly verifi ed will be  unmarked. ",DIR("A", 4)=" "
  3365   "RTN","RCD PEAA3",49, 0)
  3366    S DIR("A" )="ARE YOU  SURE YOU  WANT TO DO  THIS? "
  3367   "RTN","RCD PEAA3",50, 0)
  3368    W !
  3369   "RTN","RCD PEAA3",51, 0)
  3370    D ^DIR
  3371   "RTN","RCD PEAA3",52, 0)
  3372    K DIR
  3373   "RTN","RCD PEAA3",53, 0)
  3374    I Y'=1 D  REFQ Q
  3375   "RTN","RCD PEAA3",54, 0)
  3376    ;
  3377   "RTN","RCD PEAA3",55, 0)
  3378    ; First r emove Revi ew and Ver ify inform ation
  3379   "RTN","RCD PEAA3",56, 0)
  3380    S DA=$P(R CIENS,"^", 2),DA(1)=$ P(RCIENS," ^",1)
  3381   "RTN","RCD PEAA3",57, 0)
  3382    S DIE="^R CY(344.49, "_DA(1)_", 1,",DA=$P( RCIENS,"^" ,2),DA(1)= $P(RCIENS, "^",1)
  3383   "RTN","RCD PEAA3",58, 0)
  3384    S DR=".1/ //@;.11/// @;.12///@; .13///@"
  3385   "RTN","RCD PEAA3",59, 0)
  3386    D ^DIE
  3387   "RTN","RCD PEAA3",60, 0)
  3388    S XX=0,DA (2)=DA(1), DA(1)=DA
  3389   "RTN","RCD PEAA3",61, 0)
  3390    F  D  Q:' XX
  3391   "RTN","RCD PEAA3",62, 0)
  3392    . S XX=$O (^RCY(344. 49,DA(2),1 ,DA(1),4,X X))
  3393   "RTN","RCD PEAA3",63, 0)
  3394    . Q:'XX
  3395   "RTN","RCD PEAA3",64, 0)
  3396    . S DA=XX
  3397   "RTN","RCD PEAA3",65, 0)
  3398    . S DIK=" ^RCY(344.4 9,"_DA(2)_ ",1,"_DA(1 )_",4,"
  3399   "RTN","RCD PEAA3",66, 0)
  3400    . D ^DIK
  3401   "RTN","RCD PEAA3",67, 0)
  3402    ;
  3403   "RTN","RCD PEAA3",68, 0)
  3404    ; Next re move distr ibuted adj ustments
  3405   "RTN","RCD PEAA3",69, 0)
  3406    S XX=0
  3407   "RTN","RCD PEAA3",70, 0)
  3408    F  D  Q:' XX
  3409   "RTN","RCD PEAA3",71, 0)
  3410    . S XX=$O (^RCY(344. 49,DA(2),1 ,DA(1),1,X X))
  3411   "RTN","RCD PEAA3",72, 0)
  3412    . Q:'XX
  3413   "RTN","RCD PEAA3",73, 0)
  3414    . S DA=XX ,DIK="^RCY (344.49,"_ DA(2)_"1," _DA(1)_",1 ,"
  3415   "RTN","RCD PEAA3",74, 0)
  3416    . D ^DIK
  3417   "RTN","RCD PEAA3",75, 0)
  3418    ;
  3419   "RTN","RCD PEAA3",76, 0)
  3420    ; Finally  remove Sp lit/Edited  lines
  3421   "RTN","RCD PEAA3",77, 0)
  3422    K DA
  3423   "RTN","RCD PEAA3",78, 0)
  3424    S IENS=$P (RCIENS,"^ ",2)_","_$ P(RCIENS," ^",1)_","
  3425   "RTN","RCD PEAA3",79, 0)
  3426    D GETS^DI Q(344.491, IENS,"**", "I","OSEQ" )                ; Ge t Original  line valu es
  3427   "RTN","RCD PEAA3",80, 0)
  3428    S DA=$P(R CIENS,"^", 2)+1,DA(1) =$P(RCIENS ,"^",1)
  3429   "RTN","RCD PEAA3",81, 0)
  3430    K DR
  3431   "RTN","RCD PEAA3",82, 0)
  3432    S DIE="^R CY(344.49, "_DA(1)_", 1,"
  3433   "RTN","RCD PEAA3",83, 0)
  3434    S DR=".02 ///"_OSEQ( 344.491,IE NS,.02,"I" )_";"            ; Or iginal Cla im #
  3435   "RTN","RCD PEAA3",84, 0)
  3436    S DR=DR_" .03///"_OS EQ(344.491 ,IENS,.03, "I")_";"         ; Am ount to Po st on Rece ipt
  3437   "RTN","RCD PEAA3",85, 0)
  3438    S DR=DR_" .04///"_OS EQ(344.491 ,IENS,.04, "I")_";"         ; In clude on R eceipt
  3439   "RTN","RCD PEAA3",86, 0)
  3440    S DR=DR_" .05///"_OS EQ(344.491 ,IENS,.05, "I")_";"         ; Am ount of Pa yment
  3441   "RTN","RCD PEAA3",87, 0)
  3442    S DR=DR_" .06///"_OS EQ(344.491 ,IENS,.06, "I")_";"         ; Ne t Amount o f Payment
  3443   "RTN","RCD PEAA3",88, 0)
  3444    S DR=DR_" .08///@;.0 9///@;.10/ //@;2.03// /@;2.04/// @"    ; Nu ll out the  other fie lds
  3445   "RTN","RCD PEAA3",89, 0)
  3446    D ^DIE
  3447   "RTN","RCD PEAA3",90, 0)
  3448    S XX=DA,D ONE=0
  3449   "RTN","RCD PEAA3",91, 0)
  3450    F  D  Q:D ONE
  3451   "RTN","RCD PEAA3",92, 0)
  3452    . S XX=$O (^RCY(344. 49,DA(1),1 ,XX))
  3453   "RTN","RCD PEAA3",93, 0)
  3454    . I 'XX S  DONE=1 Q
  3455   "RTN","RCD PEAA3",94, 0)
  3456    . Q:$P($P (^RCY(344. 49,DA(1),1 ,XX,0),"^" ,1),".",1) '=SEQ      ; Not line  being ref reshed
  3457   "RTN","RCD PEAA3",95, 0)
  3458    . S DA=XX ,DIK="^RCY (344.49,"_ DA(1)_",1, "
  3459   "RTN","RCD PEAA3",96, 0)
  3460    . D ^DIK
  3461   "RTN","RCD PEAA3",97, 0)
  3462    ;
  3463   "RTN","RCD PEAA3",98, 0)
  3464    D INIT^RC DPEAA2(RCI ENS)
  3465   "RTN","RCD PEAA3",99, 0)
  3466   REFQ ;
  3467   "RTN","RCD PEAA3",100 ,0)
  3468    S VALMBG= 1,VALMBCK= "R"
  3469   "RTN","RCD PEAA3",101 ,0)
  3470    Q
  3471   "RTN","RCD PEAA3",102 ,0)
  3472    ;
  3473   "RTN","RCD PEAA3",103 ,0)
  3474   RESEARCH ;  Invoke th e research  menu off  APAR
  3475   "RTN","RCD PEAA3",104 ,0)
  3476    ;
  3477   "RTN","RCD PEAA3",105 ,0)
  3478    K ^TMP($J ,"RC_VALMB G")
  3479   "RTN","RCD PEAA3",106 ,0)
  3480    S ^TMP($J ,"RC_VALMB G")=$G(VAL MBG)
  3481   "RTN","RCD PEAA3",107 ,0)
  3482    D FULL^VA LM1
  3483   "RTN","RCD PEAA3",108 ,0)
  3484    D EN^VALM ("RCDPE AP AR EEOB RE SEARCH")
  3485   "RTN","RCD PEAA3",109 ,0)
  3486   RQ K ^TMP( $J,"RC_VAL MBG")
  3487   "RTN","RCD PEAA3",110 ,0)
  3488    Q
  3489   "RTN","RCD PEAA3",111 ,0)
  3490    ;
  3491   "RTN","RCD PEAA3",112 ,0)
  3492   VRECPT(RCI ENS) ;
  3493   "RTN","RCD PEAA3",113 ,0)
  3494    ;  
  3495   "RTN","RCD PEAA3",114 ,0)
  3496    ;    Inpu t - RCIENS  = ien of  entry in f ile 344.49 ^ien of 34 4.491^sele ctable lin e item fro m listman  screen
  3497   "RTN","RCD PEAA3",115 ,0)
  3498    ;
  3499   "RTN","RCD PEAA3",116 ,0)
  3500    D VR^RCDP EWLP($P(RC IENS,U))
  3501   "RTN","RCD PEAA3",117 ,0)
  3502    Q
  3503   "RTN","RCD PEAA3",118 ,0)
  3504   REVIEW(RCI ENS) ; Ent er review  informatio n on workl ist and tu rn review  display on /off
  3505   "RTN","RCD PEAA3",119 ,0)
  3506    ;  
  3507   "RTN","RCD PEAA3",120 ,0)
  3508    ;    Inpu t - RCIENS  = ien of  entry in f ile 344.49 ^ien of 34 4.491^sele ctable lin e item fro m listman  screen
  3509   "RTN","RCD PEAA3",121 ,0)
  3510    ;
  3511   "RTN","RCD PEAA3",122 ,0)
  3512    ;
  3513   "RTN","RCD PEAA3",123 ,0)
  3514    N Z,RC,RC DA,RCZ,DIC ,DA,DIE,DR ,X,Y,DIR,R EVCHG,RCUS PREF,RCLST REV,RCREV
  3515   "RTN","RCD PEAA3",124 ,0)
  3516    D FULL^VA LM1
  3517   "RTN","RCD PEAA3",125 ,0)
  3518    ;
  3519   "RTN","RCD PEAA3",126 ,0)
  3520    S REVCHG= ""
  3521   "RTN","RCD PEAA3",127 ,0)
  3522    S DIR(0)= "YA",RC=+$ G(^TMP($J, "RC_REVIEW "))
  3523   "RTN","RCD PEAA3",128 ,0)
  3524    S DIR("A" ,1)="REVIE W DATA DIS PLAY IS CU RRENTLY TU RNED "_$P( "OFF^ON",U ,RC+1),DIR ("A")="DO  YOU WANT T O TURN IT  "_$P("ON^O FF",U,RC+1 )_"?: ",DI R("B")=$S( 'RC:"YES", 1:"NO") W  ! D ^DIR K  DIR
  3525   "RTN","RCD PEAA3",129 ,0)
  3526    I Y=1 S ^ TMP($J,"RC _REVIEW")= ((RC+1)#2) ,REVCHG=1
  3527   "RTN","RCD PEAA3",130 ,0)
  3528    S RCUSPRE F=+$O(^RCY (344.49,$P (RCIENS,U) ,2,"B",DUZ ,0))
  3529   "RTN","RCD PEAA3",131 ,0)
  3530    ;
  3531   "RTN","RCD PEAA3",132 ,0)
  3532    I 'RCUSPR EF D  ; Ad d the user  pref reco rd
  3533   "RTN","RCD PEAA3",133 ,0)
  3534    . S RCUSP REF=+$$ADD USER($P(RC IENS,U),DU Z)
  3535   "RTN","RCD PEAA3",134 ,0)
  3536    S RCLSTRE V=+$P($G(^ RCY(344.49 ,$P(RCIENS ,U),2,RCUS PREF,0)),U ,2)
  3537   "RTN","RCD PEAA3",135 ,0)
  3538    S DA(1)=$ P(RCIENS,U ),DA=RCUSP REF
  3539   "RTN","RCD PEAA3",136 ,0)
  3540    I DA,RCLS TREV'=$G(^ TMP($J,"RC _REVIEW"))  D  ; Upda te user pr ef
  3541   "RTN","RCD PEAA3",137 ,0)
  3542    . S DIE=" ^RCY(344.4 9,"_DA(1)_ ",2,",DR=" .02////"_+ $G(^TMP($J ,"RC_REVIE W")) D ^DI E
  3543   "RTN","RCD PEAA3",138 ,0)
  3544    W !
  3545   "RTN","RCD PEAA3",139 ,0)
  3546    I '$G(^TM P($J,"RC_R EVIEW")) G  REVIEWQ
  3547   "RTN","RCD PEAA3",140 ,0)
  3548    ;
  3549   "RTN","RCD PEAA3",141 ,0)
  3550    D SEL^RCD PEWL(.RCDA )
  3551   "RTN","RCD PEAA3",142 ,0)
  3552    S RCZ=+$O (RCDA(0)), RCZ=+$G(RC DA(RCZ)) G :'RCZ REVI EWQ
  3553   "RTN","RCD PEAA3",143 ,0)
  3554    ;
  3555   "RTN","RCD PEAA3",144 ,0)
  3556    S RCREV=0
  3557   "RTN","RCD PEAA3",145 ,0)
  3558    I '$O(^RC Y(344.49,$ P(RCIENS,U ),1,"AC",D UZ,RCZ,0))  D
  3559   "RTN","RCD PEAA3",146 ,0)
  3560    . S RCREV =$$NEWREV( $P(RCIENS, U),RCZ,DUZ )
  3561   "RTN","RCD PEAA3",147 ,0)
  3562    E  D
  3563   "RTN","RCD PEAA3",148 ,0)
  3564    . N DIR,X ,Y
  3565   "RTN","RCD PEAA3",149 ,0)
  3566    . S DIR(" A")="(A)DD  or (E)DIT  A REVIEW  COMMENT?:  ",DIR("B") ="ADD",DIR (0)="SA^A: ADD;E:EDIT " W ! D ^D IR K DIR
  3567   "RTN","RCD PEAA3",150 ,0)
  3568    . I $D(DU OUT)!$D(DT OUT) Q
  3569   "RTN","RCD PEAA3",151 ,0)
  3570    . ;
  3571   "RTN","RCD PEAA3",152 ,0)
  3572    . I Y="E"  D  Q  ; E dit a revi ew entry e ntered by  same user
  3573   "RTN","RCD PEAA3",153 ,0)
  3574    .. N DA,D R,DIE,X,Y
  3575   "RTN","RCD PEAA3",154 ,0)
  3576    .. S DA(1 )=$P(RCIEN S,U),DA=RC Z,DIC="^RC Y(344.49," _DA(1)_",1 ,"_DA_",4, ",DIC(0)=" AEMQ",DIC( "S")="I $P (^(0),U,2) =DUZ" D ^D IC
  3577   "RTN","RCD PEAA3",155 ,0)
  3578    .. S RCRE V=$S(Y>0:+ Y,1:0)
  3579   "RTN","RCD PEAA3",156 ,0)
  3580    .. I RCRE V S DA(2)= $P(RCIENS, U),DA(1)=R CZ,DA=RCRE V,DIE="^RC Y(344.49," _DA(2)_",1 ,"_DA(1)_" ,4,",DR=". 03;.04//// ^S X=$$NOW ^XLFDT()"  D ^DIE
  3581   "RTN","RCD PEAA3",157 ,0)
  3582    . ;
  3583   "RTN","RCD PEAA3",158 ,0)
  3584    . S RCREV =$$NEWREV( $P(RCIENS, U),RCZ,DUZ )
  3585   "RTN","RCD PEAA3",159 ,0)
  3586    ;
  3587   "RTN","RCD PEAA3",160 ,0)
  3588    I RCREV S  DIE("NO^" )="",DA(1) =$P(RCIENS ,U),DA=RCZ ,DIE="^RCY (344.49,"_ DA(1)_",1, ",DR=".11R ;I X=0 S Y =""@10"";. 12////^S X =DUZ;S Y=" "@20"";@10 ;.12///@;@ 20" D ^DIE  K DIE
  3589   "RTN","RCD PEAA3",161 ,0)
  3590    D INIT^RC DPEAA2(RCI ENS)
  3591   "RTN","RCD PEAA3",162 ,0)
  3592    S REVCHG= ""
  3593   "RTN","RCD PEAA3",163 ,0)
  3594    ;
  3595   "RTN","RCD PEAA3",164 ,0)
  3596   REVIEWQ I  $G(REVCHG)  D INIT^RC DPEAA2(RCI ENS)
  3597   "RTN","RCD PEAA3",165 ,0)
  3598    S VALMBCK ="R"
  3599   "RTN","RCD PEAA3",166 ,0)
  3600    Q
  3601   "RTN","RCD PEAA3",167 ,0)
  3602    ;
  3603   "RTN","RCD PEAA3",168 ,0)
  3604   NEWREV(RCS CR,RCZ,RCD UZ) ; Ente r a new re view comme nt
  3605   "RTN","RCD PEAA3",169 ,0)
  3606    ; RCSCR =  ien of en try in fil e 344.49
  3607   "RTN","RCD PEAA3",170 ,0)
  3608    ; RCZ = i en of the  EEOB (seq  #)
  3609   "RTN","RCD PEAA3",171 ,0)
  3610    ; RCDUZ = DUZ of use r entering  the comme nt
  3611   "RTN","RCD PEAA3",172 ,0)
  3612    ; Functio n returns  0 if no ne w comment,  ien of co mment if a dded
  3613   "RTN","RCD PEAA3",173 ,0)
  3614    N DA,X,Y, DIC,DIK,DL AYGO,DO,DD ,RCREV,RCN OW
  3615   "RTN","RCD PEAA3",174 ,0)
  3616    S RCNOW=$ $NOW^XLFDT () W !!,"R EVIEW DATE /TIME: "_$ $FMTE^XLFD T(RCNOW,"2 ")
  3617   "RTN","RCD PEAA3",175 ,0)
  3618    S DA(2)=R CSCR,DA(1) =RCZ,X=RCN OW,DIC("DR ")=".02/// /"_RCDUZ_" ;.03",DLAY GO=344.492 ,DIC(0)="L "
  3619   "RTN","RCD PEAA3",176 ,0)
  3620    S DIC="^R CY(344.49, "_DA(2)_", 1,"_DA(1)_ ",4,"
  3621   "RTN","RCD PEAA3",177 ,0)
  3622    K DO,DD
  3623   "RTN","RCD PEAA3",178 ,0)
  3624    D FILE^DI CN K DO,DD ,DIC,DLAYG O
  3625   "RTN","RCD PEAA3",179 ,0)
  3626    S RCREV=+ Y
  3627   "RTN","RCD PEAA3",180 ,0)
  3628    I RCREV'> 0 S RCREV= 0 G NEWREV Q
  3629   "RTN","RCD PEAA3",181 ,0)
  3630    I '$O(^RC Y(344.49,D A(2),1,DA( 1),4,RCREV ,0)) S DIK ="^RCY(344 .49,"_DA(2 )_",1,"_DA (1)_",4,", DA=RCREV D  ^DIK S RC REV=0 ; No  comment -  delete en try
  3631   "RTN","RCD PEAA3",182 ,0)
  3632    ;
  3633   "RTN","RCD PEAA3",183 ,0)
  3634   NEWREVQ Q  RCREV
  3635   "RTN","RCD PEAA3",184 ,0)
  3636    ;
  3637   "RTN","RCD PEAA3",185 ,0)
  3638   ADDUSER(RC SCR,RCDUZ)  ; Add use r record t o user pre ferences m ultiple in  file 344. 49 and ini tialize al l preferen ces
  3639   "RTN","RCD PEAA3",186 ,0)
  3640    ; RCSCR =  ien of en try in fil e 344.49
  3641   "RTN","RCD PEAA3",187 ,0)
  3642    ; RCDUZ   = the ien  of the use r
  3643   "RTN","RCD PEAA3",188 ,0)
  3644    N DIC,DA, X,Y,DLAYGO ,DO,DD
  3645   "RTN","RCD PEAA3",189 ,0)
  3646    S Y=+$O(^ RCY(344.49 ,RCSCR,2," B",RCDUZ,0 ))
  3647   "RTN","RCD PEAA3",190 ,0)
  3648    I Y G ADD UQ
  3649   "RTN","RCD PEAA3",191 ,0)
  3650    S DLAYGO= 344.492,DA (1)=RCSCR, DIC(0)="L" ,X=RCDUZ,D IC="^RCY(3 44.49,"_DA (1)_",2,", DIC("DR")= ".02////0; .03////N"
  3651   "RTN","RCD PEAA3",192 ,0)
  3652    D FILE^DI CN K DIC,D LAYGO
  3653   "RTN","RCD PEAA3",193 ,0)
  3654   ADDUQ Q $S (Y>0:Y,1:0 )
  3655   "RTN","RCD PEAA3",194 ,0)
  3656    ;
  3657   "RTN","RCD PEAA3",195 ,0)
  3658   PREOB(RCIE NS) ; Prin t/View EOB  detail
  3659   "RTN","RCD PEAA3",196 ,0)
  3660    N RCDA,RC DAZ,Z,Z0
  3661   "RTN","RCD PEAA3",197 ,0)
  3662    D FULL^VA LM1
  3663   "RTN","RCD PEAA3",198 ,0)
  3664    S RCDA=$P ($G(^RCY(3 44.49,$P(R CIENS,U),1 ,$P(RCIENS ,U,2),0)), U,9)
  3665   "RTN","RCD PEAA3",199 ,0)
  3666    F RCDAZ=1 :1:$L(RCDA ,",") S RC DAZ(RCDAZ) =$P(RCDA," ,",RCDAZ)
  3667   "RTN","RCD PEAA3",200 ,0)
  3668    S Z=0 F   S Z=$O(RCD AZ(Z)) Q:' Z  D
  3669   "RTN","RCD PEAA3",201 ,0)
  3670    . ;
  3671   "RTN","RCD PEAA3",202 ,0)
  3672    . S Z0=RC DAZ(Z)
  3673   "RTN","RCD PEAA3",203 ,0)
  3674    . I $E(Z0 ,1,3)="ADJ " D  Q
  3675   "RTN","RCD PEAA3",204 ,0)
  3676    .. I $G(^ RCY(344.4, RCSCR,2,+$ P(Z0,"ADJ" ,2),0))'=" " S RCDAZ( Z)="ADJ^"_ +$P(Z0,"AD J",2)
  3677   "RTN","RCD PEAA3",205 ,0)
  3678    . ;
  3679   "RTN","RCD PEAA3",206 ,0)
  3680    . S Z0=$G (^RCY(344. 4,$P(RCIEN S,U),1,+Z0 ,0))
  3681   "RTN","RCD PEAA3",207 ,0)
  3682    . S RCDAZ (Z)=+Z0_U_ $S($P(Z0,U ,2):$P(Z0, U,2),1:-1)  Q
  3683   "RTN","RCD PEAA3",208 ,0)
  3684    ;
  3685   "RTN","RCD PEAA3",209 ,0)
  3686    D VP^RCDP EWL2($P(RC IENS,U),.R CDAZ)
  3687   "RTN","RCD PEAA3",210 ,0)
  3688    ;
  3689   "RTN","RCD PEAA3",211 ,0)
  3690    S VALMBCK ="R"
  3691   "RTN","RCD PEAA3",212 ,0)
  3692    Q
  3693   "RTN","RCD PEAA3",213 ,0)
  3694    ;
  3695   "RTN","RCD PEAA3",214 ,0)
  3696   VERIF(RCIE NS) ;EP -  Protocol a ction RCDP E APAR VER IFY
  3697   "RTN","RCD PEAA3",215 ,0)
  3698    ; Entry p oint to ve rification  options o n APAR wor klist
  3699   "RTN","RCD PEAA3",216 ,0)
  3700    ; Input:    RCIENS   - Internal  IEN of en try in fil e 344.49^i en of 
  3701   "RTN","RCD PEAA3",217 ,0)
  3702    ;                      344.491^ selectable  line item  from list man screen
  3703   "RTN","RCD PEAA3",218 ,0)
  3704    N DIR,DIR UT,DTOUT,D UOUT,RCQUI T,X,Y
  3705   "RTN","RCD PEAA3",219 ,0)
  3706    D FULL^VA LM1
  3707   "RTN","RCD PEAA3",220 ,0)
  3708    I '$D(^XU SEC("RCDPE PP",DUZ))  D  Q  ; PR CA*4.5*318  Added sec urity key  check
  3709   "RTN","RCD PEAA3",221 ,0)
  3710    . S VALMB CK="R"
  3711   "RTN","RCD PEAA3",222 ,0)
  3712    . W !!,"T his action  can only  be taken b y users th at have th e RCDPEPP  security k ey.",!
  3713   "RTN","RCD PEAA3",223 ,0)
  3714    . D PAUSE ^VALM1
  3715   "RTN","RCD PEAA3",224 ,0)
  3716    ;
  3717   "RTN","RCD PEAA3",225 ,0)
  3718    W !!!!
  3719   "RTN","RCD PEAA3",226 ,0)
  3720    S RCQUIT= 0
  3721   "RTN","RCD PEAA3",227 ,0)
  3722    F  D  Q:R CQUIT
  3723   "RTN","RCD PEAA3",228 ,0)
  3724    . S DIR(0 )="SAO^1:M ANUAL VERI FICATION;2 :REPORT UN VERIFIED D ISCREPANCI ES;3:QUIT"
  3725   "RTN","RCD PEAA3",229 ,0)
  3726    . S DIR(" A",1)="VER IFY EEOBs: "
  3727   "RTN","RCD PEAA3",230 ,0)
  3728    . S DIR(" A",2)="    1 MANUALLY  MARK AS V ERIFIED"
  3729   "RTN","RCD PEAA3",231 ,0)
  3730    . S DIR(" A",3)="    2 REPORT O F UNVERIFI ED WITH DI SCREPANCIE S"
  3731   "RTN","RCD PEAA3",232 ,0)
  3732    . S DIR(" A",4)="    3 QUIT AND  RETURN TO  WORKLIST"
  3733   "RTN","RCD PEAA3",233 ,0)
  3734    . S DIR(" A")="Selec t Action:  ",DIR("B") ="QUIT" W  ! D ^DIR K  DIR
  3735   "RTN","RCD PEAA3",234 ,0)
  3736    . I Y=3!( Y="")!$D(D UOUT)!$D(D TOUT) S RC QUIT=1 Q
  3737   "RTN","RCD PEAA3",235 ,0)
  3738    . ;
  3739   "RTN","RCD PEAA3",236 ,0)
  3740    . I Y=1 D  MVER($P(R CIENS,U))  W !! Q
  3741   "RTN","RCD PEAA3",237 ,0)
  3742    . ;
  3743   "RTN","RCD PEAA3",238 ,0)
  3744    . I Y=2 D  RPT^RCDPE V0($P(RCIE NS,U)) W ! ! Q
  3745   "RTN","RCD PEAA3",239 ,0)
  3746    ;
  3747   "RTN","RCD PEAA3",240 ,0)
  3748    S VALMBCK ="R"
  3749   "RTN","RCD PEAA3",241 ,0)
  3750    Q
  3751   "RTN","RCD PEAA3",242 ,0)
  3752    ;
  3753   "RTN","RCD PEAA3",243 ,0)
  3754   MVER(RCERA ) ; Manual ly mark an  EEOB as v erified wi thin APAR
  3755   "RTN","RCD PEAA3",244 ,0)
  3756    ; subrout ine cloned  from the  process th at VERIFIE S EEOBs of f the stan dard workl ist (MVER^ RCDPEV)
  3757   "RTN","RCD PEAA3",245 ,0)
  3758    ; but wit h specific  changes t o support  APAR
  3759   "RTN","RCD PEAA3",246 ,0)
  3760    ; this su broutine o nly needs  to VERIFY  one EEOB r ather than  a list of  EEOBs
  3761   "RTN","RCD PEAA3",247 ,0)
  3762    N A,CT,DA ,DIE,DR,DT OUT,DUOUT, Z,Z0,Z1,RC T,RCY,RCY0 ,RCZ0,RCLI NE,RCYNUM, DIR,X,Y,RE SULT,SPLIT ,Q,Q0,DT1, DT2
  3763   "RTN","RCD PEAA3",248 ,0)
  3764    N VERIFIE D
  3765   "RTN","RCD PEAA3",249 ,0)
  3766    S (VERIFI ED,RCT)=0, CT=1,Z0=""
  3767   "RTN","RCD PEAA3",250 ,0)
  3768    ; get the  EEOB entr y ien to d etermine i f already  it's alrea dy been ve rified 
  3769   "RTN","RCD PEAA3",251 ,0)
  3770    S Z1=$O(^ TMP("RCDPE -EOB_WLDX" ,$J,"")) I  Z1 S Z=^T MP("RCDPE- EOB_WLDX", $J,Z1)
  3771   "RTN","RCD PEAA3",252 ,0)
  3772    ; grab th e data bel onging to  the EEOB
  3773   "RTN","RCD PEAA3",253 ,0)
  3774    I Z]"" S  Z0=$G(^RCY (344.49,RC ERA,1,+$P( Z,U,2),0))
  3775   "RTN","RCD PEAA3",254 ,0)
  3776    ; get VER IFY data
  3777   "RTN","RCD PEAA3",255 ,0)
  3778    I Z0'="", $P(Z0,U,13 ) S VERIFI ED=1
  3779   "RTN","RCD PEAA3",256 ,0)
  3780    I VERIFIE D D  Q
  3781   "RTN","RCD PEAA3",257 ,0)
  3782    . S DIR(0 )="EA",DIR ("A",1)="T HIS EEOB I S ALREADY  VERIFIED", DIR("A")=" PRESS RETU RN TO CONT INUE: " W  ! D ^DIR K  DIR
  3783   "RTN","RCD PEAA3",258 ,0)
  3784    S RCY=+$P ($G(^TMP(" RCDPE-EOB_ WLDX",$J,Z 1)),U,2),R CLINE=+^(Z 1),RCYNUM= Z1
  3785   "RTN","RCD PEAA3",259 ,0)
  3786    S RCY0=$G (^RCY(344. 49,RCERA,1 ,RCY,0))
  3787   "RTN","RCD PEAA3",260 ,0)
  3788    S RCZ0=$G (^RCY(344. 4,RCERA,1, +$P(RCY0,U ,9),0))
  3789   "RTN","RCD PEAA3",261 ,0)
  3790    I '$P(RCZ 0,U,2) D
  3791   "RTN","RCD PEAA3",262 ,0)
  3792    . W !!,"T HIS LINE D OES NOT RE FERENCE A  VALID BILL "
  3793   "RTN","RCD PEAA3",263 ,0)
  3794    E  D
  3795   "RTN","RCD PEAA3",264 ,0)
  3796    . S RESUL T=$$VER^RC DPEV(RCERA ,+$G(^IBM( 361.1,+$P( RCZ0,U,2), 0)),+$P(RC Y0,U,9),1)
  3797   "RTN","RCD PEAA3",265 ,0)
  3798    . F Z=2:1 :9 I $E($P (RESULT,U, Z))="*" S  Q=$P(RESUL T,U,Z),$E( Q,1)="",$P (RESULT,U, Z)=Q
  3799   "RTN","RCD PEAA3",266 ,0)
  3800    . S SPLIT =$O(^RCY(3 44.49,RCER A,1,"B",+R CY0_".9999 "),-1)'=(+ RCY0_".000 1")
  3801   "RTN","RCD PEAA3",267 ,0)
  3802    . S Z=$S( SPLIT:"CLA IM #'s: ", 1:"  CLAIM  #: ")
  3803   "RTN","RCD PEAA3",268 ,0)
  3804    . S Z=Z_$ P(RCY0,U,2 )_$S('SPLI T:"",1:" ( ORIGINAL E RA DATA)")
  3805   "RTN","RCD PEAA3",269 ,0)
  3806    . I SPLIT  D
  3807   "RTN","RCD PEAA3",270 ,0)
  3808    .. S Q=+R CY0 F  S Q =$O(^RCY(3 44.49,RCER A,1,"B",Q) ) Q:(Q\1)' =+RCY0  S  Q0=+$O(^RC Y(344.49,R CERA,1,"B" ,Q,0)),Q0= $G(^RCY(34 4.49,RCERA ,1,Q0,0))  I $P(Q0,U, 2)'="" S Z =Z_" "_$P( Q0,U,2)
  3809   "RTN","RCD PEAA3",271 ,0)
  3810    . W !!!,Z
  3811   "RTN","RCD PEAA3",272 ,0)
  3812    . W !,?13 ,"PATIENT  NAME"_$J(" ",18)_"  S UBMITTED A MT    SVC  DATE(S)"
  3813   "RTN","RCD PEAA3",273 ,0)
  3814    . W !,?13 ,"-------- ---------- ---------- --  ------ ---------   --------- --------"
  3815   "RTN","RCD PEAA3",274 ,0)
  3816    . S DT1=$ E($S($P(RE SULT,U,7): $$FMTE^XLF DT($P(RESU LT,U,7),"2 D"),1:"NOT FOUND")_$J ("",8),1,8 )
  3817   "RTN","RCD PEAA3",275 ,0)
  3818    . S DT2=$ E($S($P(RE SULT,U,9): "-"_$$FMTE ^XLFDT($P( RESULT,U,9 ),"2D"),1: "-NOTFOUND ")_$J("",9 ),1,9)
  3819   "RTN","RCD PEAA3",276 ,0)
  3820    . W !,"    ERA DATA:  ",$E($P(R ESULT,U,3) _$J("",30) ,1,30),"   ",$E($J($P (RESULT,U, 5),"",2)_$ J("",15),1 ,15)_"  "_ DT1_DT2
  3821   "RTN","RCD PEAA3",277 ,0)
  3822    . W !,?15 ,$P($G(^RC Y(344,RCER A,0)),U,6)
  3823   "RTN","RCD PEAA3",278 ,0)
  3824    . S DT1=$ E($S($P(RE SULT,U,6): $$FMTE^XLF DT($P(RESU LT,U,6),"2 D"),1:"NOT FOUND")_$J ("",8),1,8 )
  3825   "RTN","RCD PEAA3",279 ,0)
  3826    . S DT2=$ E($S($P(RE SULT,U,8): "-"_$$FMTE ^XLFDT($P( RESULT,U,8 ),"2D"),1: "-NOTFOUND ")_$J("",9 ),1,9)
  3827   "RTN","RCD PEAA3",280 ,0)
  3828    . W !,"   BILL DATA:  "_$E($P(R ESULT,U,2) _$J("",30) ,1,30)_"   "_$E($J($P (RESULT,U, 4),"",2)_$ J("",15),1 ,15)_"  "_ DT1_DT2
  3829   "RTN","RCD PEAA3",281 ,0)
  3830    . W !,?15 ,$P($G(^DI C(36,+$P(R CZ0,U,4),0 )),U),!
  3831   "RTN","RCD PEAA3",282 ,0)
  3832    S DIR(0)= "YA",DIR(" A")="DO YO U WANT TO  MARK THIS  LINE VERIF IED? ",DIR ("B")="NO"  W ! D ^DI R K DIR
  3833   "RTN","RCD PEAA3",283 ,0)
  3834    ;
  3835   "RTN","RCD PEAA3",284 ,0)
  3836    I Y'=1 Q
  3837   "RTN","RCD PEAA3",285 ,0)
  3838    S DA(1)=R CERA,DA=+R CY,DIE="^R CY(344.49, "_DA(1)_", 1,",DR=".1 3////1" D  ^DIE
  3839   "RTN","RCD PEAA3",286 ,0)
  3840    S A=$$TOP LINE^RCDPE WL1($G(^RC Y(344.49,R CERA,1,+RC Y,0)),RCYN UM)
  3841   "RTN","RCD PEAA3",287 ,0)
  3842    S ^TMP("R CDPE-EOB_W L",$J,RCLI NE,0)=A
  3843   "RTN","RCD PEAA3",288 ,0)
  3844    Q
  3845   "RTN","RCD PEAA3",289 ,0)
  3846    ;
  3847   "RTN","RCD PEAA3",290 ,0)
  3848    ;PRCA*4.5 *304 - add  a claim c omment to  the ERA de tail line  from APAR
  3849   "RTN","RCD PEAA3",291 ,0)
  3850   COMNT ;
  3851   "RTN","RCD PEAA3",292 ,0)
  3852    N IEN,SEQ ,DA,DIR,DT OUT,DUOUT, X,Y,DIRUT, DIROUT,ZDA ,ZBILL,RCO MMENT,TCOM M
  3853   "RTN","RCD PEAA3",293 ,0)
  3854    S RCOMMEN T=0
  3855   "RTN","RCD PEAA3",294 ,0)
  3856    S IEN=+$P (RCIENS,U, 1)
  3857   "RTN","RCD PEAA3",295 ,0)
  3858    ; Validat e the sele ction
  3859   "RTN","RCD PEAA3",296 ,0)
  3860    I IEN=0 D   G COMQ
  3861   "RTN","RCD PEAA3",297 ,0)
  3862    . W !,"Ca nnot comme nt, no rec ord in fil e ELECTRON IC REMITTA NCE ADVICE  file sele cted." D W AIT^VALM1
  3863   "RTN","RCD PEAA3",298 ,0)
  3864    S SEQ=$P( ^RCY(344.4 9,IEN,1,+$ P(RCIENS,U ,2),0),U,9 ) ; Just g rab the fi rst sequen ce number  for the co mment.
  3865   "RTN","RCD PEAA3",299 ,0)
  3866    I $G(SEQ) ="" D  G C OMQ
  3867   "RTN","RCD PEAA3",300 ,0)
  3868    . W !,"Ca nnot comme nt, no ERA  detail re cord selec ted." D WA IT^VALM1
  3869   "RTN","RCD PEAA3",301 ,0)
  3870    I $G(^RCY (344.4,IEN ,1,SEQ,0)) ']"" D  G  COMQ
  3871   "RTN","RCD PEAA3",302 ,0)
  3872    . W !,"Ca nnot comme nt, ERA de tail recor d selected  not found ." D WAIT^ VALM1
  3873   "RTN","RCD PEAA3",303 ,0)
  3874    ;
  3875   "RTN","RCD PEAA3",304 ,0)
  3876    ; Allow u ser to put  comment o n this ERA  Detail re cord
  3877   "RTN","RCD PEAA3",305 ,0)
  3878    S ZDA=SEQ ,ZDA(1)=IE N,ZBILL=$P ($$GETBILL ^RCDPESR0( .ZDA),"-", 2)
  3879   "RTN","RCD PEAA3",306 ,0)
  3880    W !,"Ente r a commen t on ERA # "_IEN_"  E RA Detail  Seq #",SEQ ,"  Bill # ",ZBILL,!
  3881   "RTN","RCD PEAA3",307 ,0)
  3882    S DIE="^R CY(344.4," _IEN_",1," ,DA=SEQ,DA (1)=IEN,DR ="4Comment " D ^DIE G :$D(DTOUT) !$D(Y) COM Q
  3883   "RTN","RCD PEAA3",308 ,0)
  3884    ; Now fil e user (DU Z) and DAT E
  3885   "RTN","RCD PEAA3",309 ,0)
  3886    K DR
  3887   "RTN","RCD PEAA3",310 ,0)
  3888    ; If DA i s not defi ned then t he user de leted the  comment wi th an @,
  3889   "RTN","RCD PEAA3",311 ,0)
  3890    ; Delete  the user a nd date to o.
  3891   "RTN","RCD PEAA3",312 ,0)
  3892    S TCOMM=$ $GET1^DIQ( 344.41,SEQ _","_IEN_" ,",4,"E")
  3893   "RTN","RCD PEAA3",313 ,0)
  3894    I TCOMM=" " S DA=SEQ ,DA(1)=IEN ,DR="4.01/ ///@;4.02/ ///@;"
  3895   "RTN","RCD PEAA3",314 ,0)
  3896    E  S DR=" 4.01////"_ $$DT^XLFDT _";4.02/// /"_$G(DUZ) _";"
  3897   "RTN","RCD PEAA3",315 ,0)
  3898    D ^DIE
  3899   "RTN","RCD PEAA3",316 ,0)
  3900    S RCOMMEN T=1
  3901   "RTN","RCD PEAA3",317 ,0)
  3902    D WAIT^VA LM1
  3903   "RTN","RCD PEAA3",318 ,0)
  3904    ;
  3905   "RTN","RCD PEAA3",319 ,0)
  3906   COMQ I RCO MMENT D IN IT^RCDPEAA 2(RCIENS) 
  3907   "RTN","RCD PEAA3",320 ,0)
  3908    S VALMBCK ="R"
  3909   "RTN","RCD PEAA3",321 ,0)
  3910    Q
  3911   "RTN","RCD PEAC")
  3912   0^12^B1699 95417
  3913   "RTN","RCD PEAC",1,0)
  3914   RCDPEAC ;A LB/TMK/PJH  - ACTIVE  BILLS WITH  EEOB ON F ILE ;Jun 0 6, 2014@19 :11:19
  3915   "RTN","RCD PEAC",2,0)
  3916    ;;4.5;Acc ounts Rece ivable;**2 08,269,276 ,298,303,3 26,332**;M ar 20, 199 5;Build 34
  3917   "RTN","RCD PEAC",3,0)
  3918    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  3919   "RTN","RCD PEAC",4,0)
  3920    ;
  3921   "RTN","RCD PEAC",5,0)
  3922   EN ; Entry  point for  Active Bi lls With E EOB Report  [RCDPE AC TIVE WITH  EEOB REPOR T]
  3923   "RTN","RCD PEAC",6,0)
  3924    N %ZIS,CH AM,DTOUT,D UOUT,END,H DR,POP,RCC T,RCDISPTY ,RCHDR,RCI NS,RCLSTMG R,RCPAR,RC PGNUM,RCSO RT,RCSTOP, RCTMPND,RC ZRO
  3925   "RTN","RCD PEAC",7,0)
  3926    N START,T RIC,VAUTD, X,Y
  3927   "RTN","RCD PEAC",8,0)
  3928    ; PRCA*4. 5*276 - IA  1077 - Qu ery Divisi on
  3929   "RTN","RCD PEAC",9,0)
  3930    D DIVISIO N^VAUTOMA
  3931   "RTN","RCD PEAC",10,0 )
  3932    I 'VAUTD& ($D(VAUTD) '=11) Q
  3933   "RTN","RCD PEAC",11,0 )
  3934    ; PRCA*4. 5*276 - se lect repor t format
  3935   "RTN","RCD PEAC",12,0 )
  3936    Q:'$$SELE CT(.RCINS, .RCSORT,.R CZRO,.RCTY PE)
  3937   "RTN","RCD PEAC",13,0 )
  3938    ;
  3939   "RTN","RCD PEAC",14,0 )
  3940    S RCTMPND ="",RCPGNU M=0,RCSTOP =0
  3941   "RTN","RCD PEAC",15,0 )
  3942    I RCLSTMG R D  G ENO UT
  3943   "RTN","RCD PEAC",16,0 )
  3944    . S RCTMP ND=$T(+0)_ "^AR - ACT IVE BILLS  WITH EEOB  REPORT"  K  ^TMP($J,R CTMPND)  ;  clean any  residue
  3945   "RTN","RCD PEAC",17,0 )
  3946    . D ENQ
  3947   "RTN","RCD PEAC",18,0 )
  3948    . M HDR=R CHDR
  3949   "RTN","RCD PEAC",19,0 )
  3950    . D LMRPT ^RCDPEARL( .HDR,$NA(^ TMP($J,RCT MPND))) ;  generate L istMan dis play
  3951   "RTN","RCD PEAC",20,0 )
  3952    . I $D(RC TMPND) K ^ TMP($J,RCT MPND)
  3953   "RTN","RCD PEAC",21,0 )
  3954    ;
  3955   "RTN","RCD PEAC",22,0 )
  3956    W !
  3957   "RTN","RCD PEAC",23,0 )
  3958    S %ZIS="Q M" D ^%ZIS  Q:POP
  3959   "RTN","RCD PEAC",24,0 )
  3960    I $D(IO(" Q")) D  Q
  3961   "RTN","RCD PEAC",25,0 )
  3962    .N ZTDESC ,ZTRTN,ZTS AVE,ZTSK
  3963   "RTN","RCD PEAC",26,0 )
  3964    .S ZTRTN= "ENQ^RCDPE AC",ZTDESC ="AR - ACT IVE BILLS  WITH EEOB  REPORT"
  3965   "RTN","RCD PEAC",27,0 )
  3966    .S ZTSAVE ("*")=""
  3967   "RTN","RCD PEAC",28,0 )
  3968    .D ^%ZTLO AD
  3969   "RTN","RCD PEAC",29,0 )
  3970    .W !!,$S( $D(ZTSK):" Your task  number"_ZT SK_" has b een queued .",1:"Unab le to queu e this job .")
  3971   "RTN","RCD PEAC",30,0 )
  3972    .K IO("Q" ) D HOME^% ZIS
  3973   "RTN","RCD PEAC",31,0 )
  3974    U IO
  3975   "RTN","RCD PEAC",32,0 )
  3976    ;
  3977   "RTN","RCD PEAC",33,0 )
  3978   ENQ ; Queu ed entry p oint for t he report
  3979   "RTN","RCD PEAC",34,0 )
  3980    ; RCSORT  and array  RCINS must  exist
  3981   "RTN","RCD PEAC",35,0 )
  3982    ; RCINS =  "A" for a ll ins co,  "R" for r ange, "S"  for select ed individ ual
  3983   "RTN","RCD PEAC",36,0 )
  3984    ;          for RCINS ="R"  ("FR ")=from pa yer name a nd ("TR")= to payer n ame
  3985   "RTN","RCD PEAC",37,0 )
  3986    ;          for RCINS ="S"  ("S" ,INS CO IE N IN FILE  36)=""
  3987   "RTN","RCD PEAC",38,0 )
  3988    ; RCSORT  = "PN" for  sort by p atient nam e followed  by ;- if  reverse or der
  3989   "RTN","RCD PEAC",39,0 )
  3990    ;           "L4" for  sort by p atient SSN  followed  by ;- if r everse ord er
  3991   "RTN","RCD PEAC",40,0 )
  3992    ;
  3993   "RTN","RCD PEAC",41,0 )
  3994    N POSTDT, RC0,RC399, RC399M1,RC 430,RCACT, RCBILL,RCE IEN,RCEOB, RCEX,RCEXT ,RCINC,RCK EY2,RCKEY4 ,RCNEW
  3995   "RTN","RCD PEAC",42,0 )
  3996    N RCPAYNA M,RCPT,RCS SN,RCSTOP, RCTOT,RCZ, RCZ0,RCZ1, SN,X,Y,Z,Z 0
  3997   "RTN","RCD PEAC",43,0 )
  3998    K ^TMP($J ,"RCSORT")
  3999   "RTN","RCD PEAC",44,0 )
  4000    S RCCT=0  ;Page coun t for List  Manager
  4001   "RTN","RCD PEAC",45,0 )
  4002    S RCEXT=0  ; Set Exc el page 1  count
  4003   "RTN","RCD PEAC",46,0 )
  4004    I 'RCLSTM GR D HDRBL D
  4005   "RTN","RCD PEAC",47,0 )
  4006    I RCLSTMG R D HDRLM
  4007   "RTN","RCD PEAC",48,0 )
  4008    S RCACT=+ $O(^PRCA(4 30.3,"AC", 102,0)) ;  Get active  status ie n
  4009   "RTN","RCD PEAC",49,0 )
  4010    G:'RCACT  ENOUT
  4011   "RTN","RCD PEAC",50,0 )
  4012    ;
  4013   "RTN","RCD PEAC",51,0 )
  4014    I 'RCLSTM GR D HDRLS T^RCDPEARL (0,.RCHDR)   ; initia l report h eader
  4015   "RTN","RCD PEAC",52,0 )
  4016    S RCBILL= 0,RCDT=STA RT-.0001
  4017   "RTN","RCD PEAC",53,0 )
  4018    ; PRCA*4. 5*303 - Ch anged loop  to use th e "AD" ind ex on 361. 1 so that  the number  of record s checked  is limited  by
  4019   "RTN","RCD PEAC",54,0 )
  4020    ; the STA RT and END  dates of  when the E EOB was re cieved in  VistA
  4021   "RTN","RCD PEAC",55,0 )
  4022    ; PRCA*4. 5*326 - St art modifi ed block.  Change INC LUDE param s and shor ten line l engths.
  4023   "RTN","RCD PEAC",56,0 )
  4024    F  S RCDT =$O(^IBM(3 61.1,"AD", RCDT)) Q:( RCDT>(END_ ".24"))!(R CDT="")  D
  4025   "RTN","RCD PEAC",57,0 )
  4026    . S RCEIE N="" F  S  RCEIEN=$O( ^IBM(361.1 ,"AD",RCDT ,RCEIEN))  Q:RCEIEN=" "  D  ;
  4027   "RTN","RCD PEAC",58,0 )
  4028    . . S RCB ILL=$P(^IB M(361.1,RC EIEN,0),U, 1)
  4029   "RTN","RCD PEAC",59,0 )
  4030    . . S RCI NC=$$INCLU DE(RCBILL, RCEIEN,RCT YPE) ; PRC A*4.5*326  - Inclusio n by payer  or payer  type
  4031   "RTN","RCD PEAC",60,0 )
  4032    . . I RCI NC,($P(^PR CA(430,RCB ILL,0),U,8 )=RCACT),$ $EEOB(RCBI LL,.RCEOB, RCZRO) D   ; PRCA*4.5 *326
  4033   "RTN","RCD PEAC",61,0 )
  4034    . . . S ( RCTOT,RCEO B,SN)=0
  4035   "RTN","RCD PEAC",62,0 )
  4036    . . . F   S RCEOB=$O (RCEOB(RCE OB)) Q:'RC EOB  F  S  SN=$O(RCEO B(RCEOB,SN ))  Q:'SN   D
  4037   "RTN","RCD PEAC",63,0 )
  4038    . . . . S  RCTOT=RCT OT+$G(^IBM (361.1,RCE OB,1))
  4039   "RTN","RCD PEAC",64,0 )
  4040    . . . . ;  PRCA*4.5* 326 - Begi n block -  Change ins urance co.  name (fil e 36) to p ayer name  (file 344. 6)
  4041   "RTN","RCD PEAC",65,0 )
  4042    . . . . S  RCPAYNAM= $$INSNM(RC BILL,RCEIE N)
  4043   "RTN","RCD PEAC",66,0 )
  4044    . . . . S  RCKEY2=$$ SL1(RCSORT ,RCBILL),R CKEY4=+RCE OB(RCEOB,S N)_"_"_RCE OB_"_"_SN
  4045   "RTN","RCD PEAC",67,0 )
  4046    . . . . S  ^TMP($J," RCSORT",RC PAYNAM,RCK EY2,RCBILL ,RCKEY4,RC EOB)=$P(RC EOB(RCEOB, SN),U,2) ;  PRCA*4.5. 303 add ER A PD AMOUN T
  4047   "RTN","RCD PEAC",68,0 )
  4048    . . . . I  $O(RCEOB( 0)) S ^TMP ($J,"RCSOR T",RCPAYNA M,RCKEY2,R CBILL)=RCT OT   ;This  is from t he eob and  will be t he same fo r each lin e
  4049   "RTN","RCD PEAC",69,0 )
  4050    . . . . ;  PRCA*4.5* 326 - End  block
  4051   "RTN","RCD PEAC",70,0 )
  4052    ;
  4053   "RTN","RCD PEAC",71,0 )
  4054    S RCZ="", (RCSTOP,RC NEW)=0
  4055   "RTN","RCD PEAC",72,0 )
  4056    F  S RCZ= $O(^TMP($J ,"RCSORT", RCZ)) Q:RC Z=""!RCSTO P  D  S:($ G(RCINS)=" R")!($G(RC INS)="S")& (RCPGNUM>1 ) RCNEW=1
  4057   "RTN","RCD PEAC",73,0 )
  4058    . I RCSOR T'["-" D
  4059   "RTN","RCD PEAC",74,0 )
  4060    .. S RCZ0 ="" F  S R CZ0=$O(^TM P($J,"RCSO RT",RCZ,RC Z0)) Q:RCZ 0=""!RCSTO P  D OUTPU T(RCZ,RCZ0 ,RCSORT,.R CSTOP,.RCI NS,RCNEW)  S RCNEW=0
  4061   "RTN","RCD PEAC",75,0 )
  4062    . I RCSOR T["-" D
  4063   "RTN","RCD PEAC",76,0 )
  4064    .. S RCZ0 ="" F  S R CZ0=$O(^TM P($J,"RCSO RT",RCZ,RC Z0),-1) Q: RCZ0=""!RC STOP  D OU TPUT(RCZ,R CZ0,RCSORT ,.RCSTOP,. RCINS,.RCN EW) S RCNE W=0
  4065   "RTN","RCD PEAC",77,0 )
  4066    ;
  4067   "RTN","RCD PEAC",78,0 )
  4068    I '$D(^TM P($J,"RCSO RT")) S $P (Z," ",25) ="",Z=Z_"* ** NO RECO RDS TO PRI NT ***" D  SL^RCDPEAR L(Z,.RCCT, RCTMPND)
  4069   "RTN","RCD PEAC",79,0 )
  4070    I $D(^TMP ($J,"RCSOR T")),'RCST OP D SL^RC DPEARL($$E NDORPRT^RC DPEARL,.RC CT,RCTMPND )
  4071   "RTN","RCD PEAC",80,0 )
  4072    ; PRCA*4. 5*303 - If  regular r eport (no  listmanage r or queue d) ask use r to quit
  4073   "RTN","RCD PEAC",81,0 )
  4074    I 'RCSTOP ,'RCLSTMGR ,'$D(ZTQUE UED) D ASK ^RCDPEARL( .RCSTOP)
  4075   "RTN","RCD PEAC",82,0 )
  4076    ;
  4077   "RTN","RCD PEAC",83,0 )
  4078   ENOUT I $D (ZTQUEUED)  S ZTREQ=" @"
  4079   "RTN","RCD PEAC",84,0 )
  4080    I '$D(ZTQ UEUED) D ^ %ZISC
  4081   "RTN","RCD PEAC",85,0 )
  4082    K ^TMP($J ,"RCSORT") ,RCDT
  4083   "RTN","RCD PEAC",86,0 )
  4084    Q
  4085   "RTN","RCD PEAC",87,0 )
  4086    ;
  4087   "RTN","RCD PEAC",88,0 )
  4088   OUTPUT(RCZ ,RCZ0,RCSO RT,RCSTOP, RCINS,RCNE W) ; Outpu t the data
  4089   "RTN","RCD PEAC",89,0 )
  4090    ; RCZ, RC Z0 are the  first 2 s ort levels  for the a rray
  4091   "RTN","RCD PEAC",90,0 )
  4092    ; RCINS =  insurance  co info a rray
  4093   "RTN","RCD PEAC",91,0 )
  4094    ; RCSTOP  passed by  ref - retu rned if us er chooses  to stop
  4095   "RTN","RCD PEAC",92,0 )
  4096    ; RCNEW =  1 if the  header sho uld be for ced to pri nt
  4097   "RTN","RCD PEAC",93,0 )
  4098    N ZZ,RCEP D
  4099   "RTN","RCD PEAC",94,0 )
  4100    S RCBILL= 0 F  S RCB ILL=$O(^TM P($J,"RCSO RT",RCZ,RC Z0,RCBILL) ) Q:'RCBIL L!RCSTOP   S RCZ1=""  F  S RCZ1= $O(^TMP($J ,"RCSORT", RCZ,RCZ0,R CBILL,RCZ1 )) Q:RCZ1= ""!RCSTOP   D
  4101   "RTN","RCD PEAC",95,0 )
  4102    . I $D(ZT QUEUED),$$ S^%ZTLOAD  S (RCSTOP, ZTSTOP)=1  K ZTREQ I  +$G(RCSTOP ) W !!,"** *TASK STOP PED BY USE R***" Q
  4103   "RTN","RCD PEAC",96,0 )
  4104    . ; IA 19 92 - BILL/ CLAIMS fil e (#399)
  4105   "RTN","RCD PEAC",97,0 )
  4106    . S RC399 =$G(^DGCR( 399,RCBILL ,0)),RC399 M1=$G(^DGC R(399,RCBI LL,"M1")), RCPT=+$P(R C399,U,2), RC430=$G(^ PRCA(430,R CBILL,0))    ;RC430 i s from the  top level
  4107   "RTN","RCD PEAC",98,0 )
  4108    . ; PRCA* 4.5*276 -  Check for  Division
  4109   "RTN","RCD PEAC",99,0 )
  4110    . I VAUTD =0 Q:$P(RC 399,U,22)= ""  Q:$G(V AUTD($P(RC 399,U,22)) )=""
  4111   "RTN","RCD PEAC",100, 0)
  4112    . ; PRCA* 4.5*326 re move phama cy check.  Now in $$I NCLUDE log ic
  4113   "RTN","RCD PEAC",101, 0)
  4114    . S RCSTO P=$$NEWPG( .RCINS,RCN EW) S RCNE W=0 Q:RCST OP
  4115   "RTN","RCD PEAC",102, 0)
  4116    . S X=$$G ET1^DIQ(43 0,RCBILL_" ,",11)
  4117   "RTN","RCD PEAC",103, 0)
  4118    . ; PRCA* 4.5*276 -  Row #1: Pr int last 4  SSN only  - Move Bil l Number t o end
  4119   "RTN","RCD PEAC",104, 0)
  4120    . S RCSSN =$P($G(^DP T(RCPT,0)) ,U,9),RCSS N=$E(RCSSN ,$L(RCSSN) -3,$L(RCSS N))
  4121   "RTN","RCD PEAC",105, 0)
  4122    . I $G(RC DISPTY) S  RCEX=$P($G (^DPT(RCPT ,0)),U)_"^ "_RCSSN_"^ "_$TR($P(R C430,U),"- ","")
  4123   "RTN","RCD PEAC",106, 0)
  4124    . E  D
  4125   "RTN","RCD PEAC",107, 0)
  4126    . . S Z=$ E($P($G(^D PT(RCPT,0) ),U)_$J("" ,25),1,25) _"  "_$E(R CSSN_$J("" ,5),1,5)_"   "_$TR($P (RC430,U), "-","")
  4127   "RTN","RCD PEAC",108, 0)
  4128    . . D SL^ RCDPEARL(Z ,.RCCT,RCT MPND)
  4129   "RTN","RCD PEAC",109, 0)
  4130    . ; PRCA* 4.5*276 -  Row #2: Mo ve Ins Nam e, Balance , Amt Bill , Amt Paid
  4131   "RTN","RCD PEAC",110, 0)
  4132    . S Y=+$G (^TMP($J," RCSORT",RC Z,RCZ0,RCB ILL))
  4133   "RTN","RCD PEAC",111, 0)
  4134    . I $G(RC DISPTY) S  RCEX=RCEX_ "^"_RCZ_"^ "_+X_"^"_+ $P(RC430,U ,3)_"^"_Y  ; PRCA*4.5 *326 - Use  RCZ for i nsurance n ame
  4135   "RTN","RCD PEAC",112, 0)
  4136    . E  D
  4137   "RTN","RCD PEAC",113, 0)
  4138    . . ; PRC A*4.5*326  - Use RCZ  for insura nce name
  4139   "RTN","RCD PEAC",114, 0)
  4140    . . S Z=$ E(RCZ_$J(" ",30),1,30 )_$E($J("" ,12)_$J(+X ,"",2),1+$ L($J(+X,"" ,2)),12+$L ($J(+X,"", 2)))_$E($J ("",13)_$J (+$P(RC430 ,U,3),"",2 ),1+$L($J( +$P(RC430, U,3),"",2) ),13+$L($J (+$P(RC430 ,U,3),"",2 )))_$E($J( "",13),1,1 3-$L(Y))_$ J(Y,"",2)
  4141   "RTN","RCD PEAC",115, 0)
  4142    . . D SL^ RCDPEARL(Z ,.RCCT,RCT MPND)
  4143   "RTN","RCD PEAC",116, 0)
  4144    . ; PRCA* 4.5*276 Do  not displ ay Date Re ferred
  4145   "RTN","RCD PEAC",117, 0)
  4146    . S RCEOB =0,RCEPD=" " F  S RCE OB=$O(^TMP ($J,"RCSOR T",RCZ,RCZ 0,RCBILL,R CZ1,RCEOB) ) Q:'RCEOB !RCSTOP  S  RCEPD=$G( ^TMP($J,"R CSORT",RCZ ,RCZ0,RCBI LL,RCZ1,RC EOB)) D
  4147   "RTN","RCD PEAC",118, 0)
  4148    . . S RCS TOP=$$NEWP G(.RCINS,R CNEW,2)
  4149   "RTN","RCD PEAC",119, 0)
  4150    . . Q:RCS TOP
  4151   "RTN","RCD PEAC",120, 0)
  4152    . . S RC0 =$G(^IBM(3 61.1,RCEOB ,0))
  4153   "RTN","RCD PEAC",121, 0)
  4154    . . ; PRC A*4.5*276  - Row #3:  Trace#, Da te Rec'd,  Date Poste d
  4155   "RTN","RCD PEAC",122, 0)
  4156    . . I $G( RCDISPTY)  W !,RCEX_" ^"_$P(RC0, U,7)_"^"_$ $FMTE^XLFD T($P(RC0,U ,5),"2D")_ "^"_$S(RCZ 1:$$FMTE^X LFDT(+RCZ1 ,"2D"),1:" ")_"^"_RCE PD
  4157   "RTN","RCD PEAC",123, 0)
  4158    . . E  D
  4159   "RTN","RCD PEAC",124, 0)
  4160    . . . S Z ="  "_$P(R C0,U,7)_$J ("",50-$L( $P(RC0,U,7 )))_$J(RCE PD,10,2)_"  "_$E($$FM TE^XLFDT($ P(RC0,U,5) ,"2D")_$J( "",8),1,8) _" "_$E($S (RCZ1:$$FM TE^XLFDT(+ RCZ1,"2D") ,1:"")_$J( "",8),1,8)
  4161   "RTN","RCD PEAC",125, 0)
  4162    . . . D S L^RCDPEARL (Z,.RCCT,R CTMPND)
  4163   "RTN","RCD PEAC",126, 0)
  4164    . I '$G(R CDISPTY) S  Z="" D SL ^RCDPEARL( Z,.RCCT,RC TMPND)
  4165   "RTN","RCD PEAC",127, 0)
  4166    ;
  4167   "RTN","RCD PEAC",128, 0)
  4168    Q
  4169   "RTN","RCD PEAC",129, 0)
  4170    ;
  4171   "RTN","RCD PEAC",130, 0)
  4172   INCLUDE(RC Z,EOBIEN,R CTYPE) ; P RCA*4.5*32 6 change p arameters
  4173   "RTN","RCD PEAC",131, 0)
  4174    ; Functio n returns  1 if recor d should b e included  based on  ins co
  4175   "RTN","RCD PEAC",132, 0)
  4176    ; RCINS =  array con taining in surance co  informati on
  4177   "RTN","RCD PEAC",133, 0)
  4178    ; RCZ = i en of the  entry in f ile 430
  4179   "RTN","RCD PEAC",134, 0)
  4180    N OK,RCI, RCINM,RCAI NP,XX ; PR CA*4.5*326
  4181   "RTN","RCD PEAC",135, 0)
  4182    S OK=1
  4183   "RTN","RCD PEAC",136, 0)
  4184    S RCI=+$$ INS(RCZ)
  4185   "RTN","RCD PEAC",137, 0)
  4186    ;
  4187   "RTN","RCD PEAC",138, 0)
  4188    I 'RCI S  OK=0 G INC Q ; Not a  third part y bill
  4189   "RTN","RCD PEAC",139, 0)
  4190    ;
  4191   "RTN","RCD PEAC",140, 0)
  4192    ; PRCA*4. 5*326 - St art modifi ed block -  Check for  payer mat ch
  4193   "RTN","RCD PEAC",141, 0)
  4194    I RCINS'= "A" D  ;
  4195   "RTN","RCD PEAC",142, 0)
  4196    . S OK=$$ ISSEL^RCDP EU1(361.1, EOBIEN)
  4197   "RTN","RCD PEAC",143, 0)
  4198    E  I RCTY PE'="A" D   ;
  4199   "RTN","RCD PEAC",144, 0)
  4200    . S OK=$$ ISTYPE^RCD PEU1(361.1 ,EOBIEN,RC TYPE)
  4201   "RTN","RCD PEAC",145, 0)
  4202    ; PRCA*4. 5*326 - En d modified  block
  4203   "RTN","RCD PEAC",146, 0)
  4204    ;
  4205   "RTN","RCD PEAC",147, 0)
  4206   INCQ Q OK
  4207   "RTN","RCD PEAC",148, 0)
  4208    ;
  4209   "RTN","RCD PEAC",149, 0)
  4210   INSNM(RCZ, EOBIEN) ;  Returns th e name of  payer from  the ERA a ssociated  with the E OB
  4211   "RTN","RCD PEAC",150, 0)
  4212    ; If that  is null,  return the  insurance  co for bi ll ien RCZ  file 430
  4213   "RTN","RCD PEAC",151, 0)
  4214    ; Input:  RCZ = Poin t to bill,  file #430
  4215   "RTN","RCD PEAC",152, 0)
  4216    ;         EOBIEN = P ointer to  EOB file 3 61.1
  4217   "RTN","RCD PEAC",153, 0)
  4218    ; Returns : NM = Fre e text nam e of Payer  from ERA  or insuran ce on bill  if ERA no t found.
  4219   "RTN","RCD PEAC",154, 0)
  4220    ;
  4221   "RTN","RCD PEAC",155, 0)
  4222    N ERAIEN, FILE,NM
  4223   "RTN","RCD PEAC",156, 0)
  4224    S NM=""
  4225   "RTN","RCD PEAC",157, 0)
  4226    S ERAIEN= $$EOBERA^R CDPEU1(EOB IEN)
  4227   "RTN","RCD PEAC",158, 0)
  4228    I ERAIEN  S NM=$$GET NAME^RCDPE U1(344.4,E RAIEN)
  4229   "RTN","RCD PEAC",159, 0)
  4230    I NM="" S  NM=$P($G( ^DIC(36,+$ $INS(RCZ), 0)),U)
  4231   "RTN","RCD PEAC",160, 0)
  4232    Q NM
  4233   "RTN","RCD PEAC",161, 0)
  4234    ;
  4235   "RTN","RCD PEAC",162, 0)
  4236   INS(RCZ) ;  Returns i en of insu rance co f or bill ie n RCZ from  file 430
  4237   "RTN","RCD PEAC",163, 0)
  4238    N RC
  4239   "RTN","RCD PEAC",164, 0)
  4240    S RC=$P($ G(^PRCA(43 0,RCZ,0)), U,9) ;DEBT OR
  4241   "RTN","RCD PEAC",165, 0)
  4242    Q $S($P($ G(^RCD(340 ,+RC,0)),U )'["DIC(36 ":"",1:+^( 0))
  4243   "RTN","RCD PEAC",166, 0)
  4244    ;
  4245   "RTN","RCD PEAC",167, 0)
  4246   NEWPG(RCIN S,RCNEW,RC LINES) ; C heck for n ew page ne eded, outp ut header
  4247   "RTN","RCD PEAC",168, 0)
  4248    ; RCINS =  ins co se lection cr iteria
  4249   "RTN","RCD PEAC",169, 0)
  4250    ; RCNEW =  1 to forc e new page
  4251   "RTN","RCD PEAC",170, 0)
  4252    ; RCLINES  = Number  of lines b efore IOSL  to force  new page
  4253   "RTN","RCD PEAC",171, 0)
  4254    ; Functio n returns  1 if user  chooses to  stop outp ut
  4255   "RTN","RCD PEAC",172, 0)
  4256    S RCLINES =$G(RCLINE S,5)
  4257   "RTN","RCD PEAC",173, 0)
  4258    I RCNEW!( ($Y+RCLINE S)>IOSL) D
  4259   "RTN","RCD PEAC",174, 0)
  4260    . D:'$G(R CDISPTY) H DRLST^RCDP EARL(.RCST OP,.RCHDR)
  4261   "RTN","RCD PEAC",175, 0)
  4262    Q RCSTOP
  4263   "RTN","RCD PEAC",176, 0)
  4264    ;
  4265   "RTN","RCD PEAC",177, 0)
  4266   EEOB(RCZ,R CEOB,RCZRO ) ; Find a ll non-MRA   EEOBs fo r bill ien  RCZ
  4267   "RTN","RCD PEAC",178, 0)
  4268    ; Functio n returns  1 if any v alid EEOBs  found, 0  if none
  4269   "RTN","RCD PEAC",179, 0)
  4270    ; RCEOB(e ob ien)=da te posted  returned f or valid E EOBs found  -
  4271   "RTN","RCD PEAC",180, 0)
  4272    ;                 pa ss by refe rence
  4273   "RTN","RCD PEAC",181, 0)
  4274    N OK,Z,Z0 ,Z00,DET,S N,ZPD,ZINC
  4275   "RTN","RCD PEAC",182, 0)
  4276    K RCEOB
  4277   "RTN","RCD PEAC",183, 0)
  4278    ;
  4279   "RTN","RCD PEAC",184, 0)
  4280    S (Z,OK,S N,ZINC)=0
  4281   "RTN","RCD PEAC",185, 0)
  4282    ; IA 4051  for File  #361.1
  4283   "RTN","RCD PEAC",186, 0)
  4284    F  S Z=$O (^IBM(361. 1,"B",RCZ, Z)) Q:'Z   I $P($G(^I BM(361.1,Z ,0)),U,4)' =1 D
  4285   "RTN","RCD PEAC",187, 0)
  4286    . ; retri eve the EE OB data fr om ERA Det ail sub-en try
  4287   "RTN","RCD PEAC",188, 0)
  4288    . S (Z0,D ET)=0
  4289   "RTN","RCD PEAC",189, 0)
  4290    . F  S Z0 =$O(^RCY(3 44.4,"ADET ",Z,Z0)) Q :'Z0  F  S  DET=$O(^R CY(344.4," ADET",Z,Z0 ,DET)) Q:' DET  D  ;  ERA Detail
  4291   "RTN","RCD PEAC",190, 0)
  4292    . . ; PRC A*4.5*303  - added ch eck for Ze ro paid or  Paid > 0  check for  report.
  4293   "RTN","RCD PEAC",191, 0)
  4294    . . S ZIN C=0,ZPD=+$ P($G(^RCY( 344.4,Z0,1 ,DET,0)),U ,3)
  4295   "RTN","RCD PEAC",192, 0)
  4296    . . I (RC ZRO="A") S  ZINC=1 ;  PRCA*4.5*3 32
  4297   "RTN","RCD PEAC",193, 0)
  4298    . . I (RC ZRO="Z"),( ZPD=0) S Z INC=1
  4299   "RTN","RCD PEAC",194, 0)
  4300    . . I (RC ZRO="P"),( ZPD>0) S Z INC=1 ; PR CA*4.5*332
  4301   "RTN","RCD PEAC",195, 0)
  4302    . . ; PRC A*4.5*303  - Removed  looking fo r Receipt,  include r ecord base d on ERA D ETAIL POST  STATUS
  4303   "RTN","RCD PEAC",196, 0)
  4304    . . ; PRC A*4.5*303  - Removed  check for  Receipt (I f Z1 is no t empty) C hanged dat e to Piece  7 and
  4305   "RTN","RCD PEAC",197, 0)
  4306    . . ; add ed check f or either  0 paid or  paid >0 de pending on  selection . Added ER A PD AMOUN T as secon d piece of  RCEOB arr ay
  4307   "RTN","RCD PEAC",198, 0)
  4308    . . I ZIN C S SN=SN+ 1,RCEOB(Z, SN)=+$P($G (^RCY(344. 4,Z0,0)),U ,7)_U_ZPD, OK=1 ; PRC A*4.5*332
  4309   "RTN","RCD PEAC",199, 0)
  4310    ;
  4311   "RTN","RCD PEAC",200, 0)
  4312    Q OK
  4313   "RTN","RCD PEAC",201, 0)
  4314    ;
  4315   "RTN","RCD PEAC",202, 0)
  4316   SL1(RCSORT ,RCZ) ; Fu nction ret urns 1st s ort level  data from  ien RCZ in  file 430
  4317   "RTN","RCD PEAC",203, 0)
  4318    ; RCSORT  = "PN" for  patient n ame sort =  "L4" for  SSN last 4  sort
  4319   "RTN","RCD PEAC",204, 0)
  4320    N DAT
  4321   "RTN","RCD PEAC",205, 0)
  4322    I RCSORT= "PN" S DAT =$P($G(^DP T(+$P($G(^ PRCA(430,R CZ,0)),U,7 ),0)),U)
  4323   "RTN","RCD PEAC",206, 0)
  4324    I RCSORT= "L4" S DAT =$P($G(^DP T(+$P($G(^ PRCA(430,R CZ,0)),U,7 ),0)),U,9) ,DAT=$E(DA T,$L(DAT)- 3,$L(DAT))
  4325   "RTN","RCD PEAC",207, 0)
  4326    Q $S($G(D AT)'="":DA T,1:" ")
  4327   "RTN","RCD PEAC",208, 0)
  4328    ;
  4329   "RTN","RCD PEAC",209, 0)
  4330   SELECT(RCI NS,RCSORT, RCZRO,RCTY PE) ; Sele ct insuran ce co, sor t criteria , Zero Pay ment, Bill  type (Med /RX) and i f output f or EXCEL f ormat is s elected
  4331   "RTN","RCD PEAC",210, 0)
  4332    ; Functio n returns  values sel ected for  RCSORT and  RCINS - p assed by r ef
  4333   "RTN","RCD PEAC",211, 0)
  4334    N RCQUIT, DONE,DIR,X ,Y,%DT
  4335   "RTN","RCD PEAC",212, 0)
  4336    S (RCQUIT ,DONE,RCLS TMGR)=0
  4337   "RTN","RCD PEAC",213, 0)
  4338    ; PRCA*4. 5*326 - Be gin change d block -  Ask to sho w Medical/ Pharmacy T ricare or  All
  4339   "RTN","RCD PEAC",214, 0)
  4340    S RCTYPE= $$RTYPE^RC DPEU1("")
  4341   "RTN","RCD PEAC",215, 0)
  4342    I RCTYPE= -1 G SELQ
  4343   "RTN","RCD PEAC",216, 0)
  4344    ;
  4345   "RTN","RCD PEAC",217, 0)
  4346    S RCINS=$ $PAYRNG^RC DPEU1()
  4347   "RTN","RCD PEAC",218, 0)
  4348    I RCINS=- 1 G SELQ
  4349   "RTN","RCD PEAC",219, 0)
  4350    ;
  4351   "RTN","RCD PEAC",220, 0)
  4352    I RCINS'= "A" D  I X X=-1 G SEL Q
  4353   "RTN","RCD PEAC",221, 0)
  4354    . S RCPAR ("TYPE")=R CTYPE
  4355   "RTN","RCD PEAC",222, 0)
  4356    . S RCPAR ("SELC")=R CINS
  4357   "RTN","RCD PEAC",223, 0)
  4358    . S RCPAR ("DICA")=" SELECT INS URANCE COM PANY: "
  4359   "RTN","RCD PEAC",224, 0)
  4360    . S XX=$$ SELPAY^RCD PEU1(.RCPA R)
  4361   "RTN","RCD PEAC",225, 0)
  4362    ; PRCA*4. 5*326 - En d changed  block
  4363   "RTN","RCD PEAC",226, 0)
  4364    ;
  4365   "RTN","RCD PEAC",227, 0)
  4366    ; PRCA*4. 5*303 - Ad d Zero $ P rompt and  Medical/Ph armacy EEO Bs Prompt
  4367   "RTN","RCD PEAC",228, 0)
  4368    S DIR(0)= "SA^P:PAYM ENT EEOBs; Z:ZERO PAY MENT EEOBs ;A:ALL"
  4369   "RTN","RCD PEAC",229, 0)
  4370    S DIR("A" )="RUN REP ORT FOR (P )AYMENT EE OBs or (Z) ERO PAYMEN T EEOBs or  (A)LL: ", DIR("B")=" ALL"
  4371   "RTN","RCD PEAC",230, 0)
  4372    W ! D ^DI R K DIR
  4373   "RTN","RCD PEAC",231, 0)
  4374    I $D(DTOU T)!$D(DUOU T) G SELQ
  4375   "RTN","RCD PEAC",232, 0)
  4376    S RCZRO=$ E(Y,1)
  4377   "RTN","RCD PEAC",233, 0)
  4378    ;
  4379   "RTN","RCD PEAC",234, 0)
  4380    S DIR(0)= "SA^P:PATI ENT NAME;L :LAST 4 OF  PATIENT S SN",DIR("A ")="WITHIN  INS CO, S ORT BY (P) ATIENT NAM E OR (L)AS T 4 OF SSN ?: ",DIR(" B")="PATIE NT NAME" W  ! D ^DIR  K DIR
  4381   "RTN","RCD PEAC",235, 0)
  4382    I $D(DTOU T)!$D(DUOU T) G SELQ
  4383   "RTN","RCD PEAC",236, 0)
  4384    S RCSORT= $S(Y="P":" PN",1:"L4" )
  4385   "RTN","RCD PEAC",237, 0)
  4386    S DIR(0)= "SA^F:FIRS T TO LAST; L:LAST TO  FIRST",DIR ("A")="SOR T "_$S(RCS ORT="PN":" PATIENT NA ME",1:"LAS T 4")_" (F )IRST TO L AST OR (L) AST TO FIR ST?: ",DIR ("B")="FIR ST TO LAST " D ^DIR K  DIR
  4387   "RTN","RCD PEAC",238, 0)
  4388    I $D(DTOU T)!$D(DUOU T) G SELQ
  4389   "RTN","RCD PEAC",239, 0)
  4390    I Y="L" S  RCSORT=RC SORT_";-"
  4391   "RTN","RCD PEAC",240, 0)
  4392    ;
  4393   "RTN","RCD PEAC",241, 0)
  4394    ; PRCA*4. 5*298 - Ad d Date Ran ge Prompts
  4395   "RTN","RCD PEAC",242, 0)
  4396    K DIR
  4397   "RTN","RCD PEAC",243, 0)
  4398    S DIR("?" )="ENTER T HE EARLIES T RECEIVED  DATE TO I NCLUDE ON  THE REPORT "
  4399   "RTN","RCD PEAC",244, 0)
  4400    S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="ST ART DATE ( RECEIVED):  ",DIR("B" )="T" D ^D IR K DIR
  4401   "RTN","RCD PEAC",245, 0)
  4402    I $D(DTOU T)!$D(DUOU T)!(Y="")  G SELQ
  4403   "RTN","RCD PEAC",246, 0)
  4404    S START=Y
  4405   "RTN","RCD PEAC",247, 0)
  4406    K DIR
  4407   "RTN","RCD PEAC",248, 0)
  4408    S DIR("?" )="ENTER T HE LATEST  RECEIVED D ATE TO INC LUDE ON TH E REPORT"
  4409   "RTN","RCD PEAC",249, 0)
  4410    S DIR("B" )="T"
  4411   "RTN","RCD PEAC",250, 0)
  4412    S DIR(0)= "DAO^"_STA RT_":"_DT_ ":APE",DIR ("A")="END  DATE (REC EIVED): "  D ^DIR K D IR
  4413   "RTN","RCD PEAC",251, 0)
  4414    I $D(DTOU T)!$D(DUOU T)!(Y="")  G SELQ
  4415   "RTN","RCD PEAC",252, 0)
  4416    S END=Y
  4417   "RTN","RCD PEAC",253, 0)
  4418    ; PRCA*4. 5*326 - Re move old T ricare and  CHAMPVA p rompts
  4419   "RTN","RCD PEAC",254, 0)
  4420    ;
  4421   "RTN","RCD PEAC",255, 0)
  4422    ; PRCA*4. 5*276 - De termine wh ether to g ather data  for Excel  report.
  4423   "RTN","RCD PEAC",256, 0)
  4424    S RCDISPT Y=$$DISPTY ^RCDPEM3 G  SELQ:RCDI SPTY<0
  4425   "RTN","RCD PEAC",257, 0)
  4426    I RCDISPT Y D INFO^R CDPEM6 S D ONE=1 G SE LQ
  4427   "RTN","RCD PEAC",258, 0)
  4428    ;
  4429   "RTN","RCD PEAC",259, 0)
  4430    ; PRCA*4. 5*298 - Ad d ListMana ger Prompt s
  4431   "RTN","RCD PEAC",260, 0)
  4432    S RCLSTMG R=$$ASKLM^ RCDPEARL G :RCLSTMGR< 0 SELQ
  4433   "RTN","RCD PEAC",261, 0)
  4434    ;
  4435   "RTN","RCD PEAC",262, 0)
  4436    S DONE=1
  4437   "RTN","RCD PEAC",263, 0)
  4438    ;
  4439   "RTN","RCD PEAC",264, 0)
  4440   SELQ ;
  4441   "RTN","RCD PEAC",265, 0)
  4442    Q DONE
  4443   "RTN","RCD PEAC",266, 0)
  4444    ;
  4445   "RTN","RCD PEAC",267, 0)
  4446   LIST(DIR,R CINS) ; Se ts up help  array for  ins co se lected in  DIR("?")
  4447   "RTN","RCD PEAC",268, 0)
  4448    N CT,Z
  4449   "RTN","RCD PEAC",269, 0)
  4450    S CT=1
  4451   "RTN","RCD PEAC",270, 0)
  4452    I '$O(RCI NS("S",0))  S DIR("?" )="NO INSU RANCE COMP ANIES SELE CTED" Q
  4453   "RTN","RCD PEAC",271, 0)
  4454    S DIR("?" ,1)="INSUR ANCE COMPA NIES ALREA DY SELECTE D:"
  4455   "RTN","RCD PEAC",272, 0)
  4456    S Z=0 F   S Z=$O(RCI NS("S",Z))  Q:'Z  S C T=CT+1,DIR ("?",CT)="    "_$P($G (^DIC(36,Z ,0)),U)
  4457   "RTN","RCD PEAC",273, 0)
  4458    S DIR("?" )=" "
  4459   "RTN","RCD PEAC",274, 0)
  4460    Q
  4461   "RTN","RCD PEAC",275, 0)
  4462    ;
  4463   "RTN","RCD PEAC",276, 0)
  4464   HDRBLD ; c reate the  report hea der
  4465   "RTN","RCD PEAC",277, 0)
  4466    ; returns  RCHDR,RCP GNUM,RCSTO P
  4467   "RTN","RCD PEAC",278, 0)
  4468    ;   RCHDR (0) = head er text li ne count
  4469   "RTN","RCD PEAC",279, 0)
  4470    ;   RCHDR ("PGNUM")  = page num ber
  4471   "RTN","RCD PEAC",280, 0)
  4472    ;   RCHDR ("XECUTE")  = M code  for page n umber
  4473   "RTN","RCD PEAC",281, 0)
  4474    ;   RCHDR ("RUNDATE" ) = date/t ime report  generated
  4475   "RTN","RCD PEAC",282, 0)
  4476    ;   RCPGN UM - page  counter
  4477   "RTN","RCD PEAC",283, 0)
  4478    ;   RCSTO P - flag t o stop lis ting
  4479   "RTN","RCD PEAC",284, 0)
  4480    ; INPUT:
  4481   "RTN","RCD PEAC",285, 0)
  4482    ;   RCDTR NG - date  range filt er value t o be print ed as part  of the he ader
  4483   "RTN","RCD PEAC",286, 0)
  4484    ;   RCPAY  - Payer f ilter valu e(s)
  4485   "RTN","RCD PEAC",287, 0)
  4486    ;   RCLST MGR
  4487   "RTN","RCD PEAC",288, 0)
  4488    ;
  4489   "RTN","RCD PEAC",289, 0)
  4490    N Z0
  4491   "RTN","RCD PEAC",290, 0)
  4492    S Z0=""
  4493   "RTN","RCD PEAC",291, 0)
  4494    K RCHDR S  RCHDR("RU NDATE")=$$ NOW^RCDPEA RL,RCPGNUM =0,RCSTOP= 0
  4495   "RTN","RCD PEAC",292, 0)
  4496    ;
  4497   "RTN","RCD PEAC",293, 0)
  4498    I RCDISPT Y D  Q  ;  Excel form at, xecute  code is Q UIT, null  page numbe r
  4499   "RTN","RCD PEAC",294, 0)
  4500    . S RCHDR (0)=1,RCHD R("XECUTE" )="Q",RCPG NUM=""
  4501   "RTN","RCD PEAC",295, 0)
  4502    . S RCHDR (1)="PATIE NT NAME^SS N^BILL#^IN S CO NAME^ BALANCE^AM T BILLE^AM T PAID^TRA CE#^DT REC 'D^DT POST ^ERA PD AM T"
  4503   "RTN","RCD PEAC",296, 0)
  4504    ;
  4505   "RTN","RCD PEAC",297, 0)
  4506    N MSG,DAT E,Y,DIV,HC NT
  4507   "RTN","RCD PEAC",298, 0)
  4508    S RCHDR(1 )=$$HDRNM, HCNT=1  ;  line 1 wil l be repla ced by XEC UTE code b elow
  4509   "RTN","RCD PEAC",299, 0)
  4510    S RCHDR(" XECUTE")=" N Y S RCPG NUM=RCPGNU M+1,Y=$$HD RNM^"_$T(+ 0)_"_$S(RC LSTMGR:""" ",1:$J(""P age: ""_RC PGNUM,12)) ,RCHDR(1)= $J("" "",8 0-$L(Y)\2) _Y"
  4511   "RTN","RCD PEAC",300, 0)
  4512    ;
  4513   "RTN","RCD PEAC",301, 0)
  4514    S Y="RUN  DATE: "_RC HDR("RUNDA TE"),HCNT= HCNT+1,RCH DR(HCNT)=$ J("",80-$L (Y)\2)_Y
  4515   "RTN","RCD PEAC",302, 0)
  4516    I VAUTD=1  S Y="DIVI SIONS: ALL "
  4517   "RTN","RCD PEAC",303, 0)
  4518    I VAUTD=0  D
  4519   "RTN","RCD PEAC",304, 0)
  4520    . S Z0=0, Y="DIVISIO NS: " F X= 1:1 S Z0=$ O(VAUTD(Z0 )) Q:Z0=""   S:X>1 Y= Y_", " S Y =Y_VAUTD(Z 0)
  4521   "RTN","RCD PEAC",305, 0)
  4522    S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",80-$L(Y )\2)_Y
  4523   "RTN","RCD PEAC",306, 0)
  4524    I RCINS=" S" S Z=0,Z 0="" F  S  Z=$O(RCINS ("S",Z)) Q :'Z  S Z0= Z0_$S(Z0'= "":",",1:" ")_$P($G(^ DIC(36,Z,0 )),U)
  4525   "RTN","RCD PEAC",307, 0)
  4526    ; PRCA*4. 5*326 - St art modifi ed block
  4527   "RTN","RCD PEAC",308, 0)
  4528    S Z0="PAY ERS: "_$S( RCINS="A": "ALL   ",R CINS="R":" RANGE",1:" SELECTED")
  4529   "RTN","RCD PEAC",309, 0)
  4530    S Z0=Z0_$ J("",16)_" MEDICAL/PH ARMACY/TRI CARE: "_$S (RCTYPE="M ":"MEDICAL ",RCTYPE=" P":"PHARMA CY",RCTYPE ="T":"TRIC ARE",1:"AL L")
  4531   "RTN","RCD PEAC",310, 0)
  4532    S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",80-$L(Z 0)\2)_Z0,Z 0=""
  4533   "RTN","RCD PEAC",311, 0)
  4534    ; PRCA*4. 5*326 modi fy next tw o lines fo r tricare  filter
  4535   "RTN","RCD PEAC",312, 0)
  4536    S Z0=Z0_" DATE RANGE : "_$$FMTE ^XLFDT(STA RT,"2Z")_" -"_$$FMTE^ XLFDT(END, "2Z")
  4537   "RTN","RCD PEAC",313, 0)
  4538    S Z0=Z0_$ J("",16)_"   PAYMENT  TYPE: "_$S (RCZRO="Z" :"ZERO PAY MENT",RCZR O="P":"PAY MENT",1:"A LL") ; PRC A*4.5*332
  4539   "RTN","RCD PEAC",314, 0)
  4540    ; PRCA*4. 5*326 - En d modified  block
  4541   "RTN","RCD PEAC",315, 0)
  4542    ;
  4543   "RTN","RCD PEAC",316, 0)
  4544    S HCNT=HC NT+1,RCHDR (HCNT)=$J( "",80-$L(Z 0)\2)_Z0
  4545   "RTN","RCD PEAC",317, 0)
  4546    ;
  4547   "RTN","RCD PEAC",318, 0)
  4548    S HCNT=HC NT+1,RCHDR (HCNT)=""
  4549   "RTN","RCD PEAC",319, 0)
  4550    S Y="PATI ENT NAME                 SSN     BILL#",HCN T=HCNT+1,R CHDR(HCNT) =Y
  4551   "RTN","RCD PEAC",320, 0)
  4552    S Y="INS  CO NAME                           BALANCE    AMT BILLE D        A MT PAID",H CNT=HCNT+1 ,RCHDR(HCN T)=Y
  4553   "RTN","RCD PEAC",321, 0)
  4554    S Y="   T RACE#                                               ER A PD AMT   REC'D  DT  POST",HCNT =HCNT+1,RC HDR(HCNT)= Y
  4555   "RTN","RCD PEAC",322, 0)
  4556    S Y=$TR($ J("",IOM), " ","="),H CNT=HCNT+1 ,RCHDR(HCN T)=Y
  4557   "RTN","RCD PEAC",323, 0)
  4558    S RCHDR(0 )=HCNT
  4559   "RTN","RCD PEAC",324, 0)
  4560    Q
  4561   "RTN","RCD PEAC",325, 0)
  4562    ;
  4563   "RTN","RCD PEAC",326, 0)
  4564   HDRLM ; cr eate the l ist manage r version  of the rep ort header
  4565   "RTN","RCD PEAC",327, 0)
  4566    ; returns  RCHDR,RCP GNUM,RCSTO P
  4567   "RTN","RCD PEAC",328, 0)
  4568    ;   RCHDR (0) = head er text li ne count
  4569   "RTN","RCD PEAC",329, 0)
  4570    ;   RCHDR ("PGNUM")  = page num ber
  4571   "RTN","RCD PEAC",330, 0)
  4572    ;   RCHDR ("XECUTE")  = M code  for page n umber
  4573   "RTN","RCD PEAC",331, 0)
  4574    ;   RCHDR ("RUNDATE" ) = date/t ime report  generated
  4575   "RTN","RCD PEAC",332, 0)
  4576    ;   RCPGN UM - page  counter
  4577   "RTN","RCD PEAC",333, 0)
  4578    ;   RCSTO P - flag t o stop lis ting
  4579   "RTN","RCD PEAC",334, 0)
  4580    ;INPUT:
  4581   "RTN","RCD PEAC",335, 0)
  4582    ; RCDTRNG  - date ra nge filter  value to  be printed  as part o f the head er
  4583   "RTN","RCD PEAC",336, 0)
  4584    ; RCPAY -  Payer fil ter value( s)
  4585   "RTN","RCD PEAC",337, 0)
  4586    ; RCLSTMG R
  4587   "RTN","RCD PEAC",338, 0)
  4588    ;
  4589   "RTN","RCD PEAC",339, 0)
  4590    N Z0 S Z0 =""
  4591   "RTN","RCD PEAC",340, 0)
  4592    K RCHDR S  RCPGNUM=0 ,RCSTOP=0
  4593   "RTN","RCD PEAC",341, 0)
  4594    N MSG,DAT E,Y,DIV,HC NT
  4595   "RTN","RCD PEAC",342, 0)
  4596    ; PRCA*4. 5*326 Star t modified  code bloc k
  4597   "RTN","RCD PEAC",343, 0)
  4598    S HCNT=1
  4599   "RTN","RCD PEAC",344, 0)
  4600    S RCHDR(" TITLE")=$$ HDRNM,RCHD R("XECUTE" )="Q"
  4601   "RTN","RCD PEAC",345, 0)
  4602    S RCHDR(1 )="DATE RA NGE: "_$$F MTE^XLFDT( START,"2Z" )_"-"_$$FM TE^XLFDT(E ND,"2Z")_$ J("",16)
  4603   "RTN","RCD PEAC",346, 0)
  4604    S RCHDR(1 )=RCHDR(1) _"  PAYMEN T TYPE: "_ $S(RCZRO=" Z":"ZERO P AYMENT",RC ZRO="P":"P AYMENT",1: "ALL") ; P RCA*4.5*33 2
  4605   "RTN","RCD PEAC",347, 0)
  4606    I VAUTD=1  S Y="DIVI SIONS: ALL "
  4607   "RTN","RCD PEAC",348, 0)
  4608    I VAUTD=0  D
  4609   "RTN","RCD PEAC",349, 0)
  4610    . S Z0=0, Y="DIVISIO NS: " F X= 1:1 S Z0=$ O(VAUTD(Z0 )) Q:Z0=""   S:X>1 Y= Y_", " S Y =Y_VAUTD(Z 0)
  4611   "RTN","RCD PEAC",350, 0)
  4612    S HCNT=HC NT+1,RCHDR (HCNT)=Y
  4613   "RTN","RCD PEAC",351, 0)
  4614    I RCINS=" S" S Z=0,Z 0="" F  S  Z=$O(RCINS ("S",Z)) Q :'Z  S Z0= Z0_$S(Z0'= "":",",1:" ")_$P($G(^ DIC(36,Z,0 )),U)
  4615   "RTN","RCD PEAC",352, 0)
  4616    S Z0="PAY ERS: "_$S( RCINS="A": "ALL     " ,RCINS="R" :"RANGE",1 :"SELECTED ")
  4617   "RTN","RCD PEAC",353, 0)
  4618    S Z0=Z0_$ J("",44-$L (Z0))_"MED ICAL/PHARM ACY/TRICAR E: "_$S(RC TYPE="M":" MEDICAL",R CTYPE="P": "PHARMACY" ,RCTYPE="T ":"TRICARE ",1:"ALL")
  4619   "RTN","RCD PEAC",354, 0)
  4620    ; PRCA*4. 5*326 End  modified c ode block
  4621   "RTN","RCD PEAC",355, 0)
  4622    S HCNT=HC NT+1,RCHDR (HCNT)=Z0
  4623   "RTN","RCD PEAC",356, 0)
  4624    I RCINS=" A" S HCNT= HCNT+1,RCH DR(HCNT)=" "
  4625   "RTN","RCD PEAC",357, 0)
  4626    ;
  4627   "RTN","RCD PEAC",358, 0)
  4628    S Y="PATI ENT NAME                 SSN     BILL#",HCN T=HCNT+1,R CHDR(HCNT) =Y
  4629   "RTN","RCD PEAC",359, 0)
  4630    S Y="INS  CO NAME                           BALANCE    AMT BILLE D        A MT PAID",H CNT=HCNT+1 ,RCHDR(HCN T)=Y
  4631   "RTN","RCD PEAC",360, 0)
  4632    S Y="   T RACE#                                               ER A PD AMT   REC'D  DT  POST",HCNT =HCNT+1,RC HDR(HCNT)= Y
  4633   "RTN","RCD PEAC",361, 0)
  4634    S RCHDR(0 )=HCNT
  4635   "RTN","RCD PEAC",362, 0)
  4636    Q
  4637   "RTN","RCD PEAC",363, 0)
  4638    ;
  4639   "RTN","RCD PEAC",364, 0)
  4640    ; extrins ic variabl e, name fo r header P RCA*4.5*29 8
  4641   "RTN","RCD PEAC",365, 0)
  4642   HDRNM() Q  "EDI LOCKB OX ACTIVE  BILLS W/EE OB REPORT"
  4643   "RTN","RCD PEARL")
  4644   0^14^B4172 5584
  4645   "RTN","RCD PEARL",1,0 )
  4646   RCDPEARL ; ALB/hrubov cak - Misc . Report u tilities f or ListMan , etc. ;Ju n 06, 2014 @19:11:19
  4647   "RTN","RCD PEARL",2,0 )
  4648    ;;4.5;Acc ounts Rece ivable;**2 98,321,332 **;15 Apri l 2014;Bui ld 34
  4649   "RTN","RCD PEARL",3,0 )
  4650    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  4651   "RTN","RCD PEARL",4,0 )
  4652    ;
  4653   "RTN","RCD PEARL",5,0 )
  4654    ; IA 594  - ACCOUNTS  RECEIVABL E CATEGORY  file (#43 0.2)
  4655   "RTN","RCD PEARL",6,0 )
  4656    ; IA 1992  - BILL/CL AIMS file  (#399)
  4657   "RTN","RCD PEARL",7,0 )
  4658    ; IA 3822  - RATE TY PE file (# 399.3)
  4659   "RTN","RCD PEARL",8,0 )
  4660    ; IA 4051  - EXPLANA TION OF BE NEFITS fil e (#361.1)
  4661   "RTN","RCD PEARL",9,0 )
  4662    ;
  4663   "RTN","RCD PEARL",10, 0)
  4664    Q
  4665   "RTN","RCD PEARL",11, 0)
  4666    ;
  4667   "RTN","RCD PEARL",12, 0)
  4668   ASK(STOP)  ; Ask to c ontinue
  4669   "RTN","RCD PEARL",13, 0)
  4670    ; STOP pa ssed by re f., return ed as 1 if  timeout o r user ent ers '^'
  4671   "RTN","RCD PEARL",14, 0)
  4672    Q:'($E(IO ST,1,2)="C -")  ; mus t have use r
  4673   "RTN","RCD PEARL",15, 0)
  4674    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
  4675   "RTN","RCD PEARL",16, 0)
  4676    S DIR("A" )="Press e nter to co ntinue, '^ ' to exit:  "
  4677   "RTN","RCD PEARL",17, 0)
  4678    S DIR(0)= "EA" D ^DI R
  4679   "RTN","RCD PEARL",18, 0)
  4680    I ($D(DTO UT))!($D(D UOUT))!(Y= "^") S STO P=1
  4681   "RTN","RCD PEARL",19, 0)
  4682    Q
  4683   "RTN","RCD PEARL",20, 0)
  4684    ;
  4685   "RTN","RCD PEARL",21, 0)
  4686   ASKLM(DEFA ULT) ; Ext rinsic fun ction, ask  for ListM an display  using ^DI R
  4687   "RTN","RCD PEARL",22, 0)
  4688    ; Input:    DEFAULT  - 1 - Defa ult 'YES',  0 - Defau lt 'NO'
  4689   "RTN","RCD PEARL",23, 0)
  4690    ;                      Optional  defaults  to 0
  4691   "RTN","RCD PEARL",24, 0)
  4692    ; Returns : 0 - No,  1 - YES, - 1 on timeo ut or '^'
  4693   "RTN","RCD PEARL",25, 0)
  4694    N DIR,RSL T,X,Y
  4695   "RTN","RCD PEARL",26, 0)
  4696    S:'$D(DEF AULT) DEFA ULT=0 ; PR CA*4.5*332
  4697   "RTN","RCD PEARL",27, 0)
  4698    S RSLT=0
  4699   "RTN","RCD PEARL",28, 0)
  4700    S DIR(0)= "YA",DIR(" A")="Displ ay in List  Manager f ormat? (Y/ N): "
  4701   "RTN","RCD PEARL",29, 0)
  4702    S DIR("B" )=$S(DEFAU LT:"YES",1 :"NO") ; P RCA*4.5*33 2
  4703   "RTN","RCD PEARL",30, 0)
  4704    D ^DIR S  RSLT=$S($D (DUOUT)!$D (DTOUT):-1 ,1:Y)
  4705   "RTN","RCD PEARL",31, 0)
  4706    Q RSLT
  4707   "RTN","RCD PEARL",32, 0)
  4708    ;
  4709   "RTN","RCD PEARL",33, 0)
  4710   CLMCHMPV(R CLMIEN) ;  boolean fu nction, re turns true  if CHAMPV A claim, e lse false
  4711   "RTN","RCD PEARL",34, 0)
  4712    ; RCLMIEN  - file en try, forma t: 'file # ;ien' (see  PTR4302 c omments)
  4713   "RTN","RCD PEARL",35, 0)
  4714    Q $$EVALC LM(RCLMIEN ,"CHAMPVA" )
  4715   "RTN","RCD PEARL",36, 0)
  4716    ;
  4717   "RTN","RCD PEARL",37, 0)
  4718   CLMTRICR(R CLMIEN) ;  boolean fu nction, re turns true  if TRICAR E claim, e lse false
  4719   "RTN","RCD PEARL",38, 0)
  4720    ; RCLMIEN  - file en try, forma t: 'file # ;ien' (see  PTR4302 c omments)
  4721   "RTN","RCD PEARL",39, 0)
  4722    Q $$EVALC LM(RCLMIEN ,"TRICARE" )
  4723   "RTN","RCD PEARL",40, 0)
  4724    ;
  4725   "RTN","RCD PEARL",41, 0)
  4726   ENDORPRT()  ; extrins ic variabl e, formatt ed for 80  column dis play
  4727   "RTN","RCD PEARL",42, 0)
  4728    N A S A=" ***** END  OF REPORT  *****" Q $ J(" ",80-$ L(A)\2)_A
  4729   "RTN","RCD PEARL",43, 0)
  4730    ;
  4731   "RTN","RCD PEARL",44, 0)
  4732   EVALCLM(RC LMIEN,TRGT XT) ; bool ean functi on, case i nsensitive
  4733   "RTN","RCD PEARL",45, 0)
  4734    ; returns  1 if clai m has targ et text, e lse false  (error mes sages eval uate as fa lse)
  4735   "RTN","RCD PEARL",46, 0)
  4736    ; RCLMIEN  (required ) - file e ntry, form at: 'file  #;ien' (se e PTR4302  comments)
  4737   "RTN","RCD PEARL",47, 0)
  4738    ; TRGTXT  (required)  - target  text
  4739   "RTN","RCD PEARL",48, 0)
  4740    Q:($G(RCL MIEN)="")! ($G(TRGTXT )="") "^in valid"  ;  both requi red
  4741   "RTN","RCD PEARL",49, 0)
  4742    N RSLT,F, R,T
  4743   "RTN","RCD PEARL",50, 0)
  4744    S T=$$UP( TRGTXT),RS LT=0  ; te xt to uppe rcase, def ault to fa lse
  4745   "RTN","RCD PEARL",51, 0)
  4746    S F=$G(RC LMIEN) Q:' ($P(F,";") >1)!'($P(F ,";",2)>0)  RSLT  ; f ile must b e > 1 and  entry > ze ro
  4747   "RTN","RCD PEARL",52, 0)
  4748    S R=$$PTR 4302(RCLMI EN) Q:'R R SLT  ; no  text to ch eck
  4749   "RTN","RCD PEARL",53, 0)
  4750    ;
  4751   "RTN","RCD PEARL",54, 0)
  4752    S F=$$UP( $P(R,";",2 ,99))  ; t ext of ent ry from AC COUNTS REC EIVABLE CA TEGORY (#4 30.2)
  4753   "RTN","RCD PEARL",55, 0)
  4754    S RSLT=F[ T  ; boole an result
  4755   "RTN","RCD PEARL",56, 0)
  4756    Q RSLT
  4757   "RTN","RCD PEARL",57, 0)
  4758    ;
  4759   "RTN","RCD PEARL",58, 0)
  4760   INCHMPVA()  ; functio n, include  CHAMPVA q uestion
  4761   "RTN","RCD PEARL",59, 0)
  4762    ; returns  zero = No , 1 = yes,  -1 on tim eout or '^ '
  4763   "RTN","RCD PEARL",60, 0)
  4764    N DIR,DTO UT,DUOUT,R SLT,X,Y S  RSLT=0
  4765   "RTN","RCD PEARL",61, 0)
  4766    S DIR(0)= "YA",DIR(" A")="Inclu de CHAMPVA ? (Y/N): " ,DIR("B")= "YES"
  4767   "RTN","RCD PEARL",62, 0)
  4768    S DIR("?" )="Enter ' NO' to exc lude entri es related  to CHAMPV A from the  report."
  4769   "RTN","RCD PEARL",63, 0)
  4770    D ^DIR S  RSLT=$S($D (DUOUT)!$D (DTOUT):-1 ,1:Y)
  4771   "RTN","RCD PEARL",64, 0)
  4772    Q RSLT
  4773   "RTN","RCD PEARL",65, 0)
  4774    ;
  4775   "RTN","RCD PEARL",66, 0)
  4776   INTRICAR()  ; functio n, include  TRICARE q uestion
  4777   "RTN","RCD PEARL",67, 0)
  4778    ; returns  zero = No , 1 = yes,  -1 on tim eout or '^ '
  4779   "RTN","RCD PEARL",68, 0)
  4780    N DIR,DTO UT,DUOUT,R SLT,X,Y S  RSLT=0
  4781   "RTN","RCD PEARL",69, 0)
  4782    S DIR(0)= "YA",DIR(" A")="Inclu de TRICARE ? (Y/N): " ,DIR("B")= "YES"
  4783   "RTN","RCD PEARL",70, 0)
  4784    S DIR("?" )="Enter ' NO' to exc lude entri es related  to TRICAR E from the  report."
  4785   "RTN","RCD PEARL",71, 0)
  4786    D ^DIR S  RSLT=$S($D (DUOUT)!$D (DTOUT):-1 ,1:Y)
  4787   "RTN","RCD PEARL",72, 0)
  4788    Q RSLT
  4789   "RTN","RCD PEARL",73, 0)
  4790    ; Begin P RCA*4.5*32 1
  4791   "RTN","RCD PEARL",74, 0)
  4792    ;
  4793   "RTN","RCD PEARL",75, 0)
  4794   EXCHMPVA()  ; functio n, exclude  CHAMPVA q uestion -  EP RCDPEM4
  4795   "RTN","RCD PEARL",76, 0)
  4796    ; returns  zero = No , 1 = yes,  -1 on tim eout or '^ '
  4797   "RTN","RCD PEARL",77, 0)
  4798    N DIR,DTO UT,DUOUT,R SLT,X,Y S  RSLT=0
  4799   "RTN","RCD PEARL",78, 0)
  4800    S DIR(0)= "YA",DIR(" A")="Exclu de CHAMPVA ? (Y/N): " ,DIR("B")= "NO"
  4801   "RTN","RCD PEARL",79, 0)
  4802    S DIR("?" )="Enter ' Y' to excl ude entrie s related  to CHAMPVA  from the  report."
  4803   "RTN","RCD PEARL",80, 0)
  4804    D ^DIR S  RSLT=$S($D (DUOUT)!$D (DTOUT):-1 ,1:Y)
  4805   "RTN","RCD PEARL",81, 0)
  4806    Q RSLT
  4807   "RTN","RCD PEARL",82, 0)
  4808    ;
  4809   "RTN","RCD PEARL",83, 0)
  4810   EXTRICAR()  ; functio n, exclude  TRICARE q uestion -  EP RCDPEM4
  4811   "RTN","RCD PEARL",84, 0)
  4812    ; returns  zero = No , 1 = yes,  -1 on tim eout or '^ '
  4813   "RTN","RCD PEARL",85, 0)
  4814    N DIR,DTO UT,DUOUT,R SLT,X,Y S  RSLT=0
  4815   "RTN","RCD PEARL",86, 0)
  4816    S DIR(0)= "YA",DIR(" A")="Exclu de TRICARE ? (Y/N): " ,DIR("B")= "NO"
  4817   "RTN","RCD PEARL",87, 0)
  4818    S DIR("?" )="Enter ' Y' to excl ude entrie s related  to TRICARE  from the  report."
  4819   "RTN","RCD PEARL",88, 0)
  4820    D ^DIR S  RSLT=$S($D (DUOUT)!$D (DTOUT):-1 ,1:Y)
  4821   "RTN","RCD PEARL",89, 0)
  4822    Q RSLT
  4823   "RTN","RCD PEARL",90, 0)
  4824    ; End PRC A*4.5*321
  4825   "RTN","RCD PEARL",91, 0)
  4826    ;
  4827   "RTN","RCD PEARL",92, 0)
  4828   HDRLST(RCS TOP,RCHDR)  ; write t he header  in RCHDR
  4829   "RTN","RCD PEARL",93, 0)
  4830    ; RCSTOP,  RCHDR pas sed by ref .
  4831   "RTN","RCD PEARL",94, 0)
  4832    Q:RCSTOP   ; nothing  to do
  4833   "RTN","RCD PEARL",95, 0)
  4834    ;
  4835   "RTN","RCD PEARL",96, 0)
  4836    I $E(IOST ,1,2)="C-" ,'RCDISPTY ,RCPGNUM D  ASK(.RCST OP)
  4837   "RTN","RCD PEARL",97, 0)
  4838    Q:RCSTOP   ; no head er needed
  4839   "RTN","RCD PEARL",98, 0)
  4840    I 'RCDISP TY W @IOF
  4841   "RTN","RCD PEARL",99, 0)
  4842    X RCHDR(" XECUTE")   ; incremen t page cou nt, insert  into head er
  4843   "RTN","RCD PEARL",100 ,0)
  4844    N J F J=1 :1:RCHDR(0 ) W !,RCHD R(J)
  4845   "RTN","RCD PEARL",101 ,0)
  4846    Q
  4847   "RTN","RCD PEARL",102 ,0)
  4848    ;
  4849   "RTN","RCD PEARL",103 ,0)
  4850   LMEN(LMTMP ) ; Invoke  ListMan f or RCDPE M ISC REPORT S list tem plate
  4851   "RTN","RCD PEARL",104 ,0)
  4852    ; Input:    LMTMP        - Name  of a diff erent list man templa te to use
  4853   "RTN","RCD PEARL",105 ,0)
  4854    ;                          Opti onal, defa ults to ""
  4855   "RTN","RCD PEARL",106 ,0)
  4856    N XX
  4857   "RTN","RCD PEARL",107 ,0)
  4858    S XX=$S($ G(LMTMP)'= "":LMTMP,1 :"RCDPE MI SC REPORTS ") ; PRCA* 4.5*332
  4859   "RTN","RCD PEARL",108 ,0)
  4860    D EN^VALM (XX)                                           ; PRCA* 4.5*332
  4861   "RTN","RCD PEARL",109 ,0)
  4862    Q
  4863   "RTN","RCD PEARL",110 ,0)
  4864    ;
  4865   "RTN","RCD PEARL",111 ,0)
  4866   LMHDR ; Li stMan head er
  4867   "RTN","RCD PEARL",112 ,0)
  4868    N J S J=0
  4869   "RTN","RCD PEARL",113 ,0)
  4870    F J=1:1 Q :'$D(RCLMH DR(J))  S  VALMHDR(J) =RCLMHDR(J )
  4871   "RTN","RCD PEARL",114 ,0)
  4872    S:$G(RCLM HDR("TITLE "))'="" VA LM("TITLE" )=RCLMHDR( "TITLE")
  4873   "RTN","RCD PEARL",115 ,0)
  4874    Q
  4875   "RTN","RCD PEARL",116 ,0)
  4876    ;
  4877   "RTN","RCD PEARL",117 ,0)
  4878   LMINIT ; s et up List Man array,  invoked f rom inside  List Temp late
  4879   "RTN","RCD PEARL",118 ,0)
  4880    ;
  4881   "RTN","RCD PEARL",119 ,0)
  4882    N C,J,Y S  (J,C)=0
  4883   "RTN","RCD PEARL",120 ,0)
  4884    F  S J=$O (@RCLMND@( J)) Q:'J   S Y=$G(@RC LMND@(J)), C=C+1 D SE T^VALM10(C ,Y)
  4885   "RTN","RCD PEARL",121 ,0)
  4886    S VALMCNT =C
  4887   "RTN","RCD PEARL",122 ,0)
  4888    Q
  4889   "RTN","RCD PEARL",123 ,0)
  4890    ;
  4891   "RTN","RCD PEARL",124 ,0)
  4892   LMHLP ; Li stMan help
  4893   "RTN","RCD PEARL",125 ,0)
  4894    S X="?" D  DISP^XQOR M1 W !!
  4895   "RTN","RCD PEARL",126 ,0)
  4896    Q
  4897   "RTN","RCD PEARL",127 ,0)
  4898    ;
  4899   "RTN","RCD PEARL",128 ,0)
  4900   LMEXIT ; p erformed o n exiting  ListMan sc reen
  4901   "RTN","RCD PEARL",129 ,0)
  4902    K @RCLMND   ; delete  ListMan d ata
  4903   "RTN","RCD PEARL",130 ,0)
  4904    D FULL^VA LM1  ; res et termina l display
  4905   "RTN","RCD PEARL",131 ,0)
  4906    Q
  4907   "RTN","RCD PEARL",132 ,0)
  4908    ;
  4909   "RTN","RCD PEARL",133 ,0)
  4910   LMEXPND ;  expand cod e for List Man
  4911   "RTN","RCD PEARL",134 ,0)
  4912    Q
  4913   "RTN","RCD PEARL",135 ,0)
  4914    ;
  4915   "RTN","RCD PEARL",136 ,0)
  4916   LMRPT(RCLM HDR,RCLMND ,LMTMP) ;  Generate L istMan dis play
  4917   "RTN","RCD PEARL",137 ,0)
  4918    ; Input:    RCLMHDR      - Head er text, p assed by r ef. (requi red)
  4919   "RTN","RCD PEARL",138 ,0)
  4920    ;           RCLMND       - Stor age node f or ListMan  data (req uired)
  4921   "RTN","RCD PEARL",139 ,0)
  4922    ;           LMTMP        - Name  of a list man templa te to use
  4923   "RTN","RCD PEARL",140 ,0)
  4924    ;                          Opti onal, defa ults to ""
  4925   "RTN","RCD PEARL",141 ,0)
  4926    Q:'$D(RCL MHDR)  Q:( $G(RCLMND) ="")           ; both  required
  4927   "RTN","RCD PEARL",142 ,0)
  4928    S:'$D(LMT MP) LMTMP= "" ; PRCA* 4.5*332
  4929   "RTN","RCD PEARL",143 ,0)
  4930    D LMEN(LM TMP)          ; PRCA* 4.5*332
  4931   "RTN","RCD PEARL",144 ,0)
  4932    Q
  4933   "RTN","RCD PEARL",145 ,0)
  4934    ;
  4935   "RTN","RCD PEARL",146 ,0)
  4936   NOW() Q $$ FMTE^XLFDT ($$NOW^XLF DT,2)  ; e xtrinsic v ariable, n ow as MM/D D/YY@HH:MM :SS
  4937   "RTN","RCD PEARL",147 ,0)
  4938    ;
  4939   "RTN","RCD PEARL",148 ,0)
  4940   PAD(TXT,LN GTH) ; fun ction, pad  TXT with  spaces to  LNGTH
  4941   "RTN","RCD PEARL",149 ,0)
  4942    Q $$LJ^XL FSTR(TXT,L NGTH)
  4943   "RTN","RCD PEARL",150 ,0)
  4944    ;
  4945   "RTN","RCD PEARL",151 ,0)
  4946   PTR4302(FL NTRY) ; fu nction, re turns entr y from 430 .2 or erro r message
  4947   "RTN","RCD PEARL",152 ,0)
  4948    ; FLNTRY  - file ent ry (requir ed), forma t: 'file # ;ien'
  4949   "RTN","RCD PEARL",153 ,0)
  4950    ; on succ ess return s 'ien^nam e' else '^ error mess age'
  4951   "RTN","RCD PEARL",154 ,0)
  4952    ; file nu mber and i en can be  from:
  4953   "RTN","RCD PEARL",155 ,0)
  4954    ;  ^PRCA( 430.2,0) =  ACCOUNTS  RECEIVABLE  CATEGORY^ 430.2I
  4955   "RTN","RCD PEARL",156 ,0)
  4956    ;  ^DGCR( 399.3,0) =  RATE TYPE ^399.3I^
  4957   "RTN","RCD PEARL",157 ,0)
  4958    ;  ^DGCR( 399,0) = B ILL/CLAIMS ^399I
  4959   "RTN","RCD PEARL",158 ,0)
  4960    ;  ^IBM(3 61.1,0) =  EXPLANATIO N OF BENEF ITS^361.1P I^
  4961   "RTN","RCD PEARL",159 ,0)
  4962    ;  ^RCY(3 44.4,0) =  ELECTRONIC  REMITTANC E ADVICE^3 44.4I
  4963   "RTN","RCD PEARL",160 ,0)
  4964    ;  ^RCY(3 44,0) = AR  BATCH PAY MENT^344I
  4965   "RTN","RCD PEARL",161 ,0)
  4966    ;
  4967   "RTN","RCD PEARL",162 ,0)
  4968    N F,PF,RC FLNUM,RCIE N,RSLT,X,Y
  4969   "RTN","RCD PEARL",163 ,0)
  4970    ; PF - pa rent file
  4971   "RTN","RCD PEARL",164 ,0)
  4972    ; RCFLNUM  - file nu mber
  4973   "RTN","RCD PEARL",165 ,0)
  4974    ; RCIEN -  internal  entry numb er
  4975   "RTN","RCD PEARL",166 ,0)
  4976    ; RSLT -  result
  4977   "RTN","RCD PEARL",167 ,0)
  4978    ;
  4979   "RTN","RCD PEARL",168 ,0)
  4980    S RSLT=U, F=$G(FLNTR Y),RCFLNUM =+$P(F,";" ),RCIEN=+$ P(F,";",2)
  4981   "RTN","RCD PEARL",169 ,0)
  4982    Q:'(RCFLN UM>1) U_"i nvalid fil e #"
  4983   "RTN","RCD PEARL",170 ,0)
  4984    Q:'(RCIEN >0) U_"inv alid IEN"
  4985   "RTN","RCD PEARL",171 ,0)
  4986    ;
  4987   "RTN","RCD PEARL",172 ,0)
  4988    ; default  result
  4989   "RTN","RCD PEARL",173 ,0)
  4990    S RSLT="^ file "_RCF LNUM_" no  entry #"_R CIEN
  4991   "RTN","RCD PEARL",174 ,0)
  4992    ;
  4993   "RTN","RCD PEARL",175 ,0)
  4994    ; ACCOUNT S RECEIVAB LE CATEGOR Y file #43 0.2
  4995   "RTN","RCD PEARL",176 ,0)
  4996    I RCFLNUM =430.2 D   Q RSLT
  4997   "RTN","RCD PEARL",177 ,0)
  4998    .S X=$G(^ PRCA(430.2 ,RCIEN,0)) ,Y=$P(X,U)  S:Y]"" RS LT=RCIEN_" ;"_Y
  4999   "RTN","RCD PEARL",178 ,0)
  5000    ;
  5001   "RTN","RCD PEARL",179 ,0)
  5002    ; RATE TY PE file #3 99.3, (#.0 6) ACCOUNT S RECEIVAB LE CATEGOR Y [6P:430. 2]
  5003   "RTN","RCD PEARL",180 ,0)
  5004    I RCFLNUM =399.3 D   Q RSLT
  5005   "RTN","RCD PEARL",181 ,0)
  5006    .S X=$G(^ DGCR(399.3 ,RCIEN,0)) ,Y=+$P(X,U ,6) Q:'(Y> 0)
  5007   "RTN","RCD PEARL",182 ,0)
  5008    .S RSLT=$ $PTR4302(" 430.2;"_Y)
  5009   "RTN","RCD PEARL",183 ,0)
  5010    ;
  5011   "RTN","RCD PEARL",184 ,0)
  5012    ; BILL/CL AIMS file  #399, (#.0 7) RATE TY PE [7P:399 .3]
  5013   "RTN","RCD PEARL",185 ,0)
  5014    I RCFLNUM =399 D  Q  RSLT
  5015   "RTN","RCD PEARL",186 ,0)
  5016    .S X=$G(^ DGCR(399,R CIEN,0)) Q :X=""
  5017   "RTN","RCD PEARL",187 ,0)
  5018    .S PF=399 .3,RSLT="^ no pointer  to "_PF,Y =+$P(X,U,7 ) Q:'(Y>0)
  5019   "RTN","RCD PEARL",188 ,0)
  5020    .S RSLT=$ $PTR4302(P F_";"_Y)
  5021   "RTN","RCD PEARL",189 ,0)
  5022    ;
  5023   "RTN","RCD PEARL",190 ,0)
  5024    ; EXPLANA TION OF BE NEFITS fil e #361.1,  (#.01) BIL L [1P:399]
  5025   "RTN","RCD PEARL",191 ,0)
  5026    I RCFLNUM =361.1 D   Q RSLT
  5027   "RTN","RCD PEARL",192 ,0)
  5028    .S X=$G(^ IBM(361.1, RCIEN,0))  Q:X=""
  5029   "RTN","RCD PEARL",193 ,0)
  5030    .S PF=399 ,RSLT="^no  pointer t o "_PF,Y=+ $P(X,U) Q: '(Y>0)
  5031   "RTN","RCD PEARL",194 ,0)
  5032    .S RSLT=$ $PTR4302(P F_";"_Y)
  5033   "RTN","RCD PEARL",195 ,0)
  5034    ;
  5035   "RTN","RCD PEARL",196 ,0)
  5036    ; ELECTRO NIC REMITT ANCE ADVIC E file #34 4.4
  5037   "RTN","RCD PEARL",197 ,0)
  5038    ;  ERA DE TAIL sub-f ile #344.4 1, (#.02)  EOB DETAIL  [2P:361.1 ]
  5039   "RTN","RCD PEARL",198 ,0)
  5040    I RCFLNUM =344.4 D   Q RSLT
  5041   "RTN","RCD PEARL",199 ,0)
  5042    .S X=$G(^ RCY(344.4, RCIEN,0))  Q:X=""  ;  top level  entry not  found
  5043   "RTN","RCD PEARL",200 ,0)
  5044    .S RSLT=" ^sub-file  344.41 no  entries"
  5045   "RTN","RCD PEARL",201 ,0)
  5046    .; take f irst entry  that give s result f rom file # 430.2
  5047   "RTN","RCD PEARL",202 ,0)
  5048    .N J,C S  (J,C)=0 F   S J=$O(^R CY(344.4,R CIEN,1,J))  Q:'J!RSLT   S X=$G(^ (J,0)) D
  5049   "RTN","RCD PEARL",203 ,0)
  5050    ..S PF=36 1.1,RSLT=" ^no pointe r to "_PF
  5051   "RTN","RCD PEARL",204 ,0)
  5052    ..S Y=+$P (X,U,2) Q: '(Y>0)  S  C=C+1
  5053   "RTN","RCD PEARL",205 ,0)
  5054    ..S RSLT= "^sub-file  344.41 to tal checke d "_C,F=$$ PTR4302(PF _";"_Y) S: F RSLT=F
  5055   "RTN","RCD PEARL",206 ,0)
  5056    ;
  5057   "RTN","RCD PEARL",207 ,0)
  5058    ; AR BATC H PAYMENT  file #344,  (#.18) ER A REFERENC E [18P:344 .4]
  5059   "RTN","RCD PEARL",208 ,0)
  5060    I RCFLNUM =344 D  Q  RSLT
  5061   "RTN","RCD PEARL",209 ,0)
  5062    .S X=$G(^ RCY(344,RC IEN,0)) Q: X=""
  5063   "RTN","RCD PEARL",210 ,0)
  5064    .S PF=344 .4,Y=+$P(X ,U,18),RSL T="^no poi nter to "_ PF Q:'(Y>0 )
  5065   "RTN","RCD PEARL",211 ,0)
  5066    .S RSLT=$ $PTR4302(P F_";"_Y)
  5067   "RTN","RCD PEARL",212 ,0)
  5068    ;
  5069   "RTN","RCD PEARL",213 ,0)
  5070    ; finishe d all chec ks, valid  file numbe r not foun d
  5071   "RTN","RCD PEARL",214 ,0)
  5072    S RSLT=U_ "invalid f ile #"_RCF LNUM
  5073   "RTN","RCD PEARL",215 ,0)
  5074    ;
  5075   "RTN","RCD PEARL",216 ,0)
  5076    Q RSLT
  5077   "RTN","RCD PEARL",217 ,0)
  5078    ;
  5079   "RTN","RCD PEARL",218 ,0)
  5080   SL(T,RCLNC NT,RC2GLBL ) ; Set te xt into gl obal or wr ite line
  5081   "RTN","RCD PEARL",219 ,0)
  5082    ; T = tex t to outpu t
  5083   "RTN","RCD PEARL",220 ,0)
  5084    ; RCLNCNT  = line co unter, pas sed by ref . (optiona l)
  5085   "RTN","RCD PEARL",221 ,0)
  5086    ; RC2GLBL  = if non- null indic ates outpu t to globa l, no writ es
  5087   "RTN","RCD PEARL",222 ,0)
  5088    I $G(RC2G LBL)="" W  !,T Q
  5089   "RTN","RCD PEARL",223 ,0)
  5090    S RCLNCNT =RCLNCNT+1 ,^TMP($J,R C2GLBL,RCL NCNT)=T
  5091   "RTN","RCD PEARL",224 ,0)
  5092    Q
  5093   "RTN","RCD PEARL",225 ,0)
  5094    ;
  5095   "RTN","RCD PEARL",226 ,0)
  5096   UP(A) ; Re turns UPPE RCASE
  5097   "RTN","RCD PEARL",227 ,0)
  5098    Q $$UP^XL FSTR(A)
  5099   "RTN","RCD PEE")
  5100   0^19^B1147 41630
  5101   "RTN","RCD PEE",1,0)
  5102   RCDPEE ;AI TC/FA -Sel ect Partia lly Matche d EFTs ; 2 9-MAY-2018
  5103   "RTN","RCD PEE",2,0)
  5104    ;;4.5;Acc ounts Rece ivable;**3 32**;Mar 2 0, 1995;Bu ild 34
  5105   "RTN","RCD PEE",3,0)
  5106    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  5107   "RTN","RCD PEE",4,0)
  5108    Q
  5109   "RTN","RCD PEE",5,0)
  5110    ;
  5111   "RTN","RCD PEE",6,0)
  5112   EN(ERAIEN)  ;EP from  Manual Mat ch, MATCH1 ^RCDPEM2
  5113   "RTN","RCD PEE",7,0)
  5114    ; Input:    ERAIEN   - IEN of t he ERA to  show parti al matches  for
  5115   "RTN","RCD PEE",8,0)
  5116    ; Returns : IEN of t he selecte d EFT or " " if none  selected
  5117   "RTN","RCD PEE",9,0)
  5118    N RCQUIT, XX
  5119   "RTN","RCD PEE",10,0)
  5120    S RCQUIT= 0
  5121   "RTN","RCD PEE",11,0)
  5122    K ^TMP("R CPM_PARAMS ",$J),^TMP ("RCDPEU1" ,$J)
  5123   "RTN","RCD PEE",12,0)
  5124    S ^TMP("R CPM_PARAMS ",$J,"ERAI EN")=ERAIE N
  5125   "RTN","RCD PEE",13,0)
  5126    D FULL^VA LM1
  5127   "RTN","RCD PEE",14,0)
  5128    S RCQUIT= $$DTR()                              ; Set  date range  filter
  5129   "RTN","RCD PEE",15,0)
  5130    Q:RCQUIT
  5131   "RTN","RCD PEE",16,0)
  5132    S RCQUIT= $$CLAIMTYP ()                        ; Ask  Claim Type
  5133   "RTN","RCD PEE",17,0)
  5134    Q:RCQUIT
  5135   "RTN","RCD PEE",18,0)
  5136    S RCQUIT= $$PAYR()                             ; Ask  for select ed payers
  5137   "RTN","RCD PEE",19,0)
  5138    Q:RCQUIT
  5139   "RTN","RCD PEE",20,0)
  5140    D EN^VALM ("RCDPE EF T PARTIAL  MATCH")
  5141   "RTN","RCD PEE",21,0)
  5142    Q
  5143   "RTN","RCD PEE",22,0)
  5144    ;
  5145   "RTN","RCD PEE",23,0)
  5146   DTR() ;EP  from RCDPE PMR
  5147   "RTN","RCD PEE",24,0)
  5148    ; Date Ra nge Select ion
  5149   "RTN","RCD PEE",25,0)
  5150    ; Input:    ^TMP("RC PM_PARAMS" ,$J,"RCDT" ) - Curren t selected  Date Rang e (if any)
  5151   "RTN","RCD PEE",26,0)
  5152    ; Output:   ^TMP("RC PM_PARAMS" ,$J,"RCDT" ) - Update d Selected  Date Rang e
  5153   "RTN","RCD PEE",27,0)
  5154    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  5155   "RTN","RCD PEE",28,0)
  5156    N DIR,DIR UT,DTOUT,D TQUIT,DUOU T,FROM,RCD TRNG,TO,Y
  5157   "RTN","RCD PEE",29,0)
  5158    S ^TMP("R CPM_PARAMS ",$J,"RCDT ")="0^"_DT
  5159   "RTN","RCD PEE",30,0)
  5160    S DTQUIT= 0
  5161   "RTN","RCD PEE",31,0)
  5162    S FROM=$P ($G(^TMP(" RCPM_PARAM S",$J,"RCD T")),"^",1 )
  5163   "RTN","RCD PEE",32,0)
  5164    S TO=$P($ G(^TMP("RC PM_PARAMS" ,$J,"RCDT" )),"^",2)
  5165   "RTN","RCD PEE",33,0)
  5166    S RCDTRNG =$$DTRANGE (FROM,TO)
  5167   "RTN","RCD PEE",34,0)
  5168    Q:RCDTRNG ="^" 1
  5169   "RTN","RCD PEE",35,0)
  5170    S ^TMP("R CPM_PARAMS ",$J,"RCDT ")=RCDTRNG
  5171   "RTN","RCD PEE",36,0)
  5172    Q 0
  5173   "RTN","RCD PEE",37,0)
  5174    ;
  5175   "RTN","RCD PEE",38,0)
  5176   DTRANGE(DE FFROM,DEFT O) ; Asks  for and re turns a Da te Range
  5177   "RTN","RCD PEE",39,0)
  5178    ; Input:    DEFFROM  - Default  FROM date
  5179   "RTN","RCD PEE",40,0)
  5180    ;           DEFTO    - Default  TO date
  5181   "RTN","RCD PEE",41,0)
  5182    ; Output:   From_Dat e^To_Date  (YYYMMDD^Y YYDDMM) or  "^" (time out or ^ e ntered)
  5183   "RTN","RCD PEE",42,0)
  5184    N DIR,Y,D TOUT,DUOUT ,RCDFR,STA RT
  5185   "RTN","RCD PEE",43,0)
  5186    S RCQUIT= 0
  5187   "RTN","RCD PEE",44,0)
  5188    S DIR(0)= "DAE^:"_DT _":E"
  5189   "RTN","RCD PEE",45,0)
  5190    S DIR("A" )="Earlies t date: "
  5191   "RTN","RCD PEE",46,0)
  5192    S DIR("?" )="Enter t he start o f the date  range."
  5193   "RTN","RCD PEE",47,0)
  5194    S:($G(DEF FROM)) DIR ("B")=$$FM TE^XLFDT(D EFFROM,2)
  5195   "RTN","RCD PEE",48,0)
  5196    D ^DIR
  5197   "RTN","RCD PEE",49,0)
  5198    I $D(DTOU T)!$D(DUOU T) Q "^"
  5199   "RTN","RCD PEE",50,0)
  5200    S RCDFR=Y ,START=$$F MTE^XLFDT( RCDFR,"2DZ ")
  5201   "RTN","RCD PEE",51,0)
  5202    K DIR
  5203   "RTN","RCD PEE",52,0)
  5204    S DIR(0)= "DAE^"_RCD FR_":"_DT_ ":E"
  5205   "RTN","RCD PEE",53,0)
  5206    S DIR("A" )="Latest  date: "
  5207   "RTN","RCD PEE",54,0)
  5208    S DIR("?" ,1)="Enter  the end o f the date  range. Th e ending d ate must b e greater  than "
  5209   "RTN","RCD PEE",55,0)
  5210    S DIR("?" )="or equa l to "_STA RT_"."
  5211   "RTN","RCD PEE",56,0)
  5212    S:($G(DEF TO)) DIR(" B")=$$FMTE ^XLFDT(DEF TO,2)
  5213   "RTN","RCD PEE",57,0)
  5214    D ^DIR
  5215   "RTN","RCD PEE",58,0)
  5216    I $D(DTOU T)!$D(DUOU T) Q "^"
  5217   "RTN","RCD PEE",59,0)
  5218    Q (RCDFR_ "^"_Y)
  5219   "RTN","RCD PEE",60,0)
  5220    ;
  5221   "RTN","RCD PEE",61,0)
  5222   CLAIMTYP()   ;EP from  RCDPEPMR
  5223   "RTN","RCD PEE",62,0)
  5224    ; Claim T ype (Medic al/Pharmac y/Both) Se lection
  5225   "RTN","RCD PEE",63,0)
  5226    ; Input:    ^TMP("RC PM_PARAMS" )              - Glob al array o f preferre d values ( if any)
  5227   "RTN","RCD PEE",64,0)
  5228    ; Output:   ^TMP("RC PM_PARAMS" ,$J,"RCTYP E") - EFT  Claim Type  filter
  5229   "RTN","RCD PEE",65,0)
  5230    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  5231   "RTN","RCD PEE",66,0)
  5232    N RCTYPE
  5233   "RTN","RCD PEE",67,0)
  5234    S RCTYPE= $$RTYPE^RC DPEU1("ALL ")
  5235   "RTN","RCD PEE",68,0)
  5236    I RCTYPE< 0 Q 1
  5237   "RTN","RCD PEE",69,0)
  5238    S ^TMP("R CPM_PARAMS ",$J,"RCTY PE")=RCTYP E
  5239   "RTN","RCD PEE",70,0)
  5240    Q 0
  5241   "RTN","RCD PEE",71,0)
  5242    ;
  5243   "RTN","RCD PEE",72,0)
  5244   PAYR() ;EP  from RCDP EPMR
  5245   "RTN","RCD PEE",73,0)
  5246    ; Payer S election
  5247   "RTN","RCD PEE",74,0)
  5248    ; Input:    ^TMP("RC PM_PARAMS" ,$J,"RCTYP E")     -  M/P/T filt er selecti on
  5249   "RTN","RCD PEE",75,0)
  5250    ; Output:   ^TMP("RC PM_PARAMS" ,$J,"RCPAY R")     -  Payer filt er selecti on
  5251   "RTN","RCD PEE",76,0)
  5252    ;           ^TMP("RC DPEU1",$J)                    -  If specifi c payers w ere select ed
  5253   "RTN","RCD PEE",77,0)
  5254    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  5255   "RTN","RCD PEE",78,0)
  5256    N RCPAR,R CPAY,RCTYP E,XX
  5257   "RTN","RCD PEE",79,0)
  5258    K ^TMP("R CPDEU1",$J )
  5259   "RTN","RCD PEE",80,0)
  5260    S RCTYPE= $G(^TMP("R CPM_PARAMS ",$J,"RCTY PE"))
  5261   "RTN","RCD PEE",81,0)
  5262    S RCPAY=$ $PAYRNG^RC DPEU1(0,0, 0,"SELECT" )        ;  Selected  or Range o f Payers
  5263   "RTN","RCD PEE",82,0)
  5264    Q:RCPAY=- 1 1
  5265   "RTN","RCD PEE",83,0)
  5266    ;
  5267   "RTN","RCD PEE",84,0)
  5268    I RCPAY'= "A" D  Q:X X=-1 1                ; Since we  don't wan t all paye rs 
  5269   "RTN","RCD PEE",85,0)
  5270    . S RCPAR ("SELC")=R CPAY                  ; prompt f or payers  we do want
  5271   "RTN","RCD PEE",86,0)
  5272    . S RCPAR ("TYPE")=R CTYPE
  5273   "RTN","RCD PEE",87,0)
  5274    . S RCPAR ("FILE")=3 44.31
  5275   "RTN","RCD PEE",88,0)
  5276    . S RCPAR ("DICA")=" Select Ins urance Com pany NAME:  "
  5277   "RTN","RCD PEE",89,0)
  5278    . S XX=$$ SELPAY^RCD PEU1(.RCPA R)
  5279   "RTN","RCD PEE",90,0)
  5280    S ^TMP("R CPM_PARAMS ",$J,"RCPA YR")=RCPAY
  5281   "RTN","RCD PEE",91,0)
  5282    Q 0
  5283   "RTN","RCD PEE",92,0)
  5284    ;
  5285   "RTN","RCD PEE",93,0)
  5286   HDR ;EP fr om listman  template  RCDPE EFT  PARTIAL MA TCH
  5287   "RTN","RCD PEE",94,0)
  5288    ; Display  listman h eader
  5289   "RTN","RCD PEE",95,0)
  5290    ; Input:  ^TMP("RCPM _PARAMS",$ J)
  5291   "RTN","RCD PEE",96,0)
  5292    ; Output:  VALMHDR
  5293   "RTN","RCD PEE",97,0)
  5294    N ERAIEN, X,XX,XX2,Y Y
  5295   "RTN","RCD PEE",98,0)
  5296    S X=$G(^T MP("RCPM_P ARAMS",$J, "RCDT"))
  5297   "RTN","RCD PEE",99,0)
  5298    S XX="DAT E RANGE: "
  5299   "RTN","RCD PEE",100,0 )
  5300    S XX=XX_$ $FMTE^XLFD T($P(X,"^" ,1),"2ZD")
  5301   "RTN","RCD PEE",101,0 )
  5302    I $P(X,"^ ",2) S XX= XX_"-"_$$F MTE^XLFDT( $P(X,"^",2 ),"2ZD")
  5303   "RTN","RCD PEE",102,0 )
  5304    S X=$G(^T MP("RCPM_P ARAMS",$J, "RCTYPE"))
  5305   "RTN","RCD PEE",103,0 )
  5306    S XX2="M/ P/T: "
  5307   "RTN","RCD PEE",104,0 )
  5308    S XX2=XX2 _$S(X="M": "MEDICAL O NLY",X="P" :"PHARMACY  ONLY",X=" T":"TRICAR E ONLY",1: "ALL")
  5309   "RTN","RCD PEE",105,0 )
  5310    S XX=$$SE TSTR^VALM1 (XX2,XX,35 ,21)
  5311   "RTN","RCD PEE",106,0 )
  5312    ;
  5313   "RTN","RCD PEE",107,0 )
  5314    S X=$G(^T MP("RCPM_P ARAMS",$J, "RCPAYR"))
  5315   "RTN","RCD PEE",108,0 )
  5316    I $P(X,"^ ",1)="A"!( X="") D
  5317   "RTN","RCD PEE",109,0 )
  5318    . S XX2=" ALL PAYERS "
  5319   "RTN","RCD PEE",110,0 )
  5320    E  S XX2= "SELECTED"
  5321   "RTN","RCD PEE",111,0 )
  5322    S XX2="PA YERS: "_XX 2
  5323   "RTN","RCD PEE",112,0 )
  5324    S XX=$$SE TSTR^VALM1 (XX2,XX,62 ,18)
  5325   "RTN","RCD PEE",113,0 )
  5326    S VALMHDR (1)=XX
  5327   "RTN","RCD PEE",114,0 )
  5328    ;
  5329   "RTN","RCD PEE",115,0 )
  5330    ; Build 2 nd Header  Line
  5331   "RTN","RCD PEE",116,0 )
  5332    S ERAIEN= $G(^TMP("R CPM_PARAMS ",$J,"ERAI EN"))
  5333   "RTN","RCD PEE",117,0 )
  5334    S XX="ERA  #: "_ERAI EN
  5335   "RTN","RCD PEE",118,0 )
  5336    S XX2=$$G ET1^DIQ(34 4.4,ERAIEN _",",.02," I")          ; ERA Tr ace #
  5337   "RTN","RCD PEE",119,0 )
  5338    S XX2="Tr ace #: "_X X2
  5339   "RTN","RCD PEE",120,0 )
  5340    S XX=$$SE TSTR^VALM1 (XX2,XX,20 ,60)
  5341   "RTN","RCD PEE",121,0 )
  5342    S VALMHDR (2)=XX
  5343   "RTN","RCD PEE",122,0 )
  5344    ;
  5345   "RTN","RCD PEE",123,0 )
  5346    ; Build 3 rd Header  Line
  5347   "RTN","RCD PEE",124,0 )
  5348    S YY=$$GE T1^DIQ(344 .4,ERAIEN_ ",",.03,"I ")           ; ERA Pa yer TIN
  5349   "RTN","RCD PEE",125,0 )
  5350    S XX=$$GE T1^DIQ(344 .4,ERAIEN_ ",",.06,"I ")           ; ERA Pa yer Name
  5351   "RTN","RCD PEE",126,0 )
  5352    S XX2=XX_ "/"_YY
  5353   "RTN","RCD PEE",127,0 )
  5354    S:$L(XX2) >63 XX2=$E (XX,1,79-$ L(YY))_"/" _YY
  5355   "RTN","RCD PEE",128,0 )
  5356    S VALMHDR (3)="Payer  Name/TIN:  "_XX2
  5357   "RTN","RCD PEE",129,0 )
  5358    ;
  5359   "RTN","RCD PEE",130,0 )
  5360    ; Build 4 TH Header  Line
  5361   "RTN","RCD PEE",131,0 )
  5362    S YY=$$GE T1^DIQ(344 .4,ERAIEN_ ",",.05,"I ")           ; ERA To tal Amount  Paid
  5363   "RTN","RCD PEE",132,0 )
  5364    S XX="  T otal Amt P d: "_$J(YY ,12,2)
  5365   "RTN","RCD PEE",133,0 )
  5366    S VALMHDR (4)=XX
  5367   "RTN","RCD PEE",134,0 )
  5368    ;
  5369   "RTN","RCD PEE",135,0 )
  5370    S VALMHDR (5)=""
  5371   "RTN","RCD PEE",136,0 )
  5372    S VALMHDR (6)=" #    EFT #       Trace Num ber                                            Total A mt Pd"
  5373   "RTN","RCD PEE",137,0 )
  5374    Q
  5375   "RTN","RCD PEE",138,0 )
  5376    ;
  5377   "RTN","RCD PEE",139,0 )
  5378   INIT ;EP f rom listma n template  RCDPE EFT  PARTIAL M ATCH
  5379   "RTN","RCD PEE",140,0 )
  5380    ; Display  listman b ody
  5381   "RTN","RCD PEE",141,0 )
  5382    ; Build t he display  of EFTs t hat are pa rtially ma tched
  5383   "RTN","RCD PEE",142,0 )
  5384    ; Input:    ^TMP("RC PM_PARAMS" ,#J)  - Se lected Par ameters
  5385   "RTN","RCD PEE",143,0 )
  5386    N EFTAMT, EFTDR,EFTR EM,EFTTIN, EFTTR,ERAI EN,ERATIN, ERATOT,ERA TR,RCDTFR, RCDTTO,XX
  5387   "RTN","RCD PEE",144,0 )
  5388    D CLEAN^V ALM10
  5389   "RTN","RCD PEE",145,0 )
  5390    K ^TMP("R CPM-WL",$J ),^TMP("RC PM-WL_WLDX ",$J),^TMP ($J,"RCPM_ LIST")
  5391   "RTN","RCD PEE",146,0 )
  5392    S ERAIEN= $G(^TMP("R CPM_PARAMS ",$J,"ERAI EN"))
  5393   "RTN","RCD PEE",147,0 )
  5394    S XX=$G(^ TMP("RCPM_ PARAMS",$J ,"RCDT"))
  5395   "RTN","RCD PEE",148,0 )
  5396    S RCDTFR= +$P(XX,"^" ,1)
  5397   "RTN","RCD PEE",149,0 )
  5398    S RCDTTO= $S($P(XX," ^",2):$P(X X,"^",2),1 :DT)
  5399   "RTN","RCD PEE",150,0 )
  5400    S ERATIN= $$GET1^DIQ (344.4,ERA IEN_",",.0 3,"I")       ; ERA Pa yer TIN
  5401   "RTN","RCD PEE",151,0 )
  5402    S ERATIN= $$UP^XLFST R(ERATIN)
  5403   "RTN","RCD PEE",152,0 )
  5404    S ERATR=$ $GET1^DIQ( 344.4,ERAI EN_",",.02 ,"I")        ; ERA Tr ace #
  5405   "RTN","RCD PEE",153,0 )
  5406    S ERATR=$ $UP^XLFSTR (ERATR)
  5407   "RTN","RCD PEE",154,0 )
  5408    S ERATOT= $$GET1^DIQ (344.4,ERA IEN_",",.0 5,"I")       ; ERA To tal Amount  Paid
  5409   "RTN","RCD PEE",155,0 )
  5410    S EFTIEN= 0
  5411   "RTN","RCD PEE",156,0 )
  5412    ;
  5413   "RTN","RCD PEE",157,0 )
  5414    ; Search  for all un matched, n ot removed  EFTs that  are parti ally match ed for 
  5415   "RTN","RCD PEE",158,0 )
  5416    ; the spe cified dat e range
  5417   "RTN","RCD PEE",159,0 )
  5418    F  D  Q:' EFTIEN
  5419   "RTN","RCD PEE",160,0 )
  5420    . S EFTIE N=$O(^RCY( 344.31,"AM ATCH",0,EF TIEN))
  5421   "RTN","RCD PEE",161,0 )
  5422    . Q:'EFTI EN
  5423   "RTN","RCD PEE",162,0 )
  5424    . S EFTRE M=$$GET1^D IQ(344.31, EFTIEN_"," ,.17,"I")    ; User w ho removed  EFT
  5425   "RTN","RCD PEE",163,0 )
  5426    . Q:EFTRE M'=""                                         ; Skip r emoved EFT s
  5427   "RTN","RCD PEE",164,0 )
  5428    . S EFTAM T=$$GET1^D IQ(344.31, EFTIEN_"," ,.07,"I")    ; Amount  of Paymen t
  5429   "RTN","RCD PEE",165,0 )
  5430    . Q:'EFTA MT                                            ; Skip E FTs with n o Payment  Amount
  5431   "RTN","RCD PEE",166,0 )
  5432    . S EFTDR =$$GET1^DI Q(344.31,E FTIEN_",", .13,"I")     ; Date R eceived
  5433   "RTN","RCD PEE",167,0 )
  5434    . Q:$$FMD IFF^XLFDT( RCDTFR,EFT DR,1)>0                 ; Date R eceived be fore start  of range
  5435   "RTN","RCD PEE",168,0 )
  5436    . Q:$$FMD IFF^XLFDT( EFTDR,RCDT TO,1)>0                 ; Date R eceived af ter end of  range
  5437   "RTN","RCD PEE",169,0 )
  5438    . Q:'$$FI LTEFT(EFTI EN)                                ; Didn't  pass sele cted filte rs
  5439   "RTN","RCD PEE",170,0 )
  5440    . D EFTCH K(EFTIEN,E RATIN,ERAT OT,ERATR)               ; Check  for partia l matched  EFTs
  5441   "RTN","RCD PEE",171,0 )
  5442    ;
  5443   "RTN","RCD PEE",172,0 )
  5444    I $D(^TMP ($J,"RCPM_ LIST")) D  BLD Q                   ; Build  the list m ain displa y
  5445   "RTN","RCD PEE",173,0 )
  5446    ;
  5447   "RTN","RCD PEE",174,0 )
  5448    ; No EFTs  found, di splay the  message be low in the  list area
  5449   "RTN","RCD PEE",175,0 )
  5450    S ^TMP("R CPM-WL",$J ,1,0)="THE RE ARE NO  EFTs MATCH ING YOUR S ELECTION C RITERIA"
  5451   "RTN","RCD PEE",176,0 )
  5452    S VALMCNT =0
  5453   "RTN","RCD PEE",177,0 )
  5454    Q
  5455   "RTN","RCD PEE",178,0 )
  5456    ;
  5457   "RTN","RCD PEE",179,0 )
  5458   EFTCHK(EFT IEN,ERATIN ,ERATOT,ER ATR) ; Che ck for par tially mat ched EFTs
  5459   "RTN","RCD PEE",180,0 )
  5460    ; Input:    EFTIEN   - IEN of t he EFT bei ng checked  (#344.31)
  5461   "RTN","RCD PEE",181,0 )
  5462    ;           ERATIN   - Payer TI N on the E RA record
  5463   "RTN","RCD PEE",182,0 )
  5464    ;           ERATOT   - ERA Tota l Amount P aid
  5465   "RTN","RCD PEE",183,0 )
  5466    ;           ERATR    - ERA Trac e #
  5467   "RTN","RCD PEE",184,0 )
  5468    ; Output:   ^TMP($J, "RCPM_LIST ,MATCHW,EF TSEQ)=A1^. ..^A11 Whe re
  5469   "RTN","RCD PEE",185,0 )
  5470    ;                      MATCHW -  Weighted  number der ived from  partial ma tches
  5471   "RTN","RCD PEE",186,0 )
  5472    ;                      EFTSEQ -  Unique EF T Sequence  #
  5473   "RTN","RCD PEE",187,0 )
  5474    ;                      A1 - Num ber of mat ches betwe en the ERA  and the E FT
  5475   "RTN","RCD PEE",188,0 )
  5476    ;                      A2 - Pay er TIN # i f matched,  else ""
  5477   "RTN","RCD PEE",189,0 )
  5478    ;                      A3 - Pay er Trace #  if matche d, else ""
  5479   "RTN","RCD PEE",190,0 )
  5480    ;                      A4 - Tot al Amount  paid if ma tched else  ""
  5481   "RTN","RCD PEE",191,0 )
  5482    ;                      A5 - Mat ched weigh ted value
  5483   "RTN","RCD PEE",192,0 )
  5484    ;                           10  points for  a match o n Trace Nu mber
  5485   "RTN","RCD PEE",193,0 )
  5486    ;                            5  points for  a match o n Total Am ount
  5487   "RTN","RCD PEE",194,0 )
  5488    ;                            1  point for  a match on  TIN
  5489   "RTN","RCD PEE",195,0 )
  5490    ;                           Onl y matches  with a wei gted value  of 5 or m ore are di splayed
  5491   "RTN","RCD PEE",196,0 )
  5492    ;                      A6 - EFT  IEN
  5493   "RTN","RCD PEE",197,0 )
  5494    ;                      A7 - Dep osit #
  5495   "RTN","RCD PEE",198,0 )
  5496    ;                      A8 - Int ernal Depo sit Date
  5497   "RTN","RCD PEE",199,0 )
  5498    ;                      A9 - Pay er Name/TI N (max 58  characters )
  5499   "RTN","RCD PEE",200,0 )
  5500    ;                      A10- EFT  Trace #
  5501   "RTN","RCD PEE",201,0 )
  5502    ;                      A11- EFT  Total Amo unt Paid
  5503   "RTN","RCD PEE",202,0 )
  5504    N DEPDT,D EPNUM,EFTS EQ,EFTTOT, EFTTIN,EFT TR,MATCH,M ATCHW,PAYN M,XX,YY
  5505   "RTN","RCD PEE",203,0 )
  5506    ;
  5507   "RTN","RCD PEE",204,0 )
  5508    S (EFTSEQ ,XX)=$$GET 1^DIQ(344. 31,EFTIEN_ ",",.01,"I ") ; IEN f or 344.3
  5509   "RTN","RCD PEE",205,0 )
  5510    S DEPNUM= $$GET1^DIQ (344.3,XX_ ",",.06,"I ")           ; Deposi t #
  5511   "RTN","RCD PEE",206,0 )
  5512    S DEPDT=$ $GET1^DIQ( 344.3,XX_" ,",.07,"I" )            ; Deposi t Date
  5513   "RTN","RCD PEE",207,0 )
  5514    Q:$E(DEPN UM,1,3)="H AC"
  5515   "RTN","RCD PEE",208,0 )
  5516    S MATCHW= 0,MATCH=""
  5517   "RTN","RCD PEE",209,0 )
  5518    S XX=$$GE T1^DIQ(344 .31,EFTIEN _",",.14," I")          ; EFT Tr ansaction  #
  5519   "RTN","RCD PEE",210,0 )
  5520    S:XX'=""  EFTSEQ=EFT SEQ_"."_XX                         ; EFT Se quence num ber
  5521   "RTN","RCD PEE",211,0 )
  5522    S EFTTOT= $$GET1^DIQ (344.31,EF TIEN_",",. 07,"I")      ; EFT To tal Amount  Paid
  5523   "RTN","RCD PEE",212,0 )
  5524    S EFTTIN= $$GET1^DIQ (344.31,EF TIEN_",",. 03,"I")      ; EFT TI N
  5525   "RTN","RCD PEE",213,0 )
  5526    S EFTTIN= $$UP^XLFST R(EFTTIN)
  5527   "RTN","RCD PEE",214,0 )
  5528    S EFTTR=$ $GET1^DIQ( 344.31,EFT IEN_",",.0 4,"I")       ; EFT Tr ace #
  5529   "RTN","RCD PEE",215,0 )
  5530    S EFTTR=$ $UP^XLFSTR (EFTTR)
  5531   "RTN","RCD PEE",216,0 )
  5532    I EFTTIN= ERATIN D                                      ; Payer  TIN match
  5533   "RTN","RCD PEE",217,0 )
  5534    . S MATCH =1,MATCHW= MATCHW+1
  5535   "RTN","RCD PEE",218,0 )
  5536    . S $P(MA TCH,"^",2) =EFTTIN
  5537   "RTN","RCD PEE",219,0 )
  5538    I EFTTR=E RATR D                                        ; Trace  # number m atch
  5539   "RTN","RCD PEE",220,0 )
  5540    . S XX=$P (MATCH,"^" ,1),MATCHW =MATCHW+10
  5541   "RTN","RCD PEE",221,0 )
  5542    . S $P(MA TCH,"^",1) =XX+1
  5543   "RTN","RCD PEE",222,0 )
  5544    . S $P(MA TCH,"^",3) =EFTTR
  5545   "RTN","RCD PEE",223,0 )
  5546    I EFTTOT= ERATOT D                                      ; Total  Amount Pai d match
  5547   "RTN","RCD PEE",224,0 )
  5548    . S XX=$P (MATCH,"^" ,1),MATCHW =MATCHW+5
  5549   "RTN","RCD PEE",225,0 )
  5550    . S $P(MA TCH,"^",1) =XX+1
  5551   "RTN","RCD PEE",226,0 )
  5552    . S $P(MA TCH,"^",4) =EFTTOT
  5553   "RTN","RCD PEE",227,0 )
  5554    Q:MATCHW< 5                                             ; Only T IN match,  skip
  5555   "RTN","RCD PEE",228,0 )
  5556    S $P(MATC H,"^",6)=E FTIEN                              ; EFT IE N
  5557   "RTN","RCD PEE",229,0 )
  5558    S $P(MATC H,"^",7)=D EPNUM                              ; Deposi t #
  5559   "RTN","RCD PEE",230,0 )
  5560    S $P(MATC H,"^",8)=D EPDT                               ; Deposi t Date (in ternal)
  5561   "RTN","RCD PEE",231,0 )
  5562    S PAYNM=$ $GET1^DIQ( 344.31,EFT IEN_",",.0 2,"I")       ; EFT Pa yer Name
  5563   "RTN","RCD PEE",232,0 )
  5564    S XX=PAYN M_"/"_EFTT IN
  5565   "RTN","RCD PEE",233,0 )
  5566    S:$L(XX)> 73 XX=$E(P AYNM,1,79- $L(EFTTIN) )_"/"_EFTT IN
  5567   "RTN","RCD PEE",234,0 )
  5568    S $P(MATC H,"^",9)=X X
  5569   "RTN","RCD PEE",235,0 )
  5570    S $P(MATC H,"^",10)= EFTTR
  5571   "RTN","RCD PEE",236,0 )
  5572    S $P(MATC H,"^",11)= EFTTOT
  5573   "RTN","RCD PEE",237,0 )
  5574    S ^TMP($J ,"RCPM_LIS T",MATCHW, EFTSEQ)=MA TCH
  5575   "RTN","RCD PEE",238,0 )
  5576    Q
  5577   "RTN","RCD PEE",239,0 )
  5578    ;
  5579   "RTN","RCD PEE",240,0 )
  5580   FILTEFT(EF TIEN) ; Ch eck to see  if the EF T passes f ilter chec ks
  5581   "RTN","RCD PEE",241,0 )
  5582    ; Input:    EFTIEN                             - IEN  for the EF T (#344.31 )
  5583   "RTN","RCD PEE",242,0 )
  5584    ;           ^TMP("RC PM_PARAMS" ,$J,"RCPAY R") - Paye r Selectio n - 'A','S ' or 'R'
  5585   "RTN","RCD PEE",243,0 )
  5586    ;           ^TMP("RC PM_PARAMS" ,$J,"RCTYP E") - M/P/ T Selectio n - 'A','M ', 'P' or  'T'
  5587   "RTN","RCD PEE",244,0 )
  5588    ;           ^TMP("RC DPEU1",$J)                - Sele cted payer s if ALL n ot selecte d
  5589   "RTN","RCD PEE",245,0 )
  5590    ; Returns : 1 if EFT  passes fi lter check s, 0 other wise
  5591   "RTN","RCD PEE",246,0 )
  5592    N RCFLAG, RCPAY,RCTY PE,XX
  5593   "RTN","RCD PEE",247,0 )
  5594    S XX=$G(^ TMP("RCPM_ PARAMS",$J ,"RCPAYR") )
  5595   "RTN","RCD PEE",248,0 )
  5596    S RCPAY=$ P(XX,"^",1 )
  5597   "RTN","RCD PEE",249,0 )
  5598    S RCTYPE= $G(^TMP("R CPM_PARAMS ",$J,"RCTY PE"))
  5599   "RTN","RCD PEE",250,0 )
  5600    ;
  5601   "RTN","RCD PEE",251,0 )
  5602    ; Payer f ilter chec k
  5603   "RTN","RCD PEE",252,0 )
  5604    I RCPAY'= "A" D  Q:' XX 0
  5605   "RTN","RCD PEE",253,0 )
  5606    . S XX=$$ ISSEL^RCDP EU1(344.31 ,EFTIEN)
  5607   "RTN","RCD PEE",254,0 )
  5608    ;
  5609   "RTN","RCD PEE",255,0 )
  5610    ; M/P/T f ilter chec k
  5611   "RTN","RCD PEE",256,0 )
  5612    I RCTYPE' ="A" D  Q: 'XX 0
  5613   "RTN","RCD PEE",257,0 )
  5614    . S XX=$$ ISTYPE^RCD PEU1(344.3 1,EFTIEN,R CTYPE)
  5615   "RTN","RCD PEE",258,0 )
  5616    Q 1
  5617   "RTN","RCD PEE",259,0 )
  5618    ;
  5619   "RTN","RCD PEE",260,0 )
  5620   BLD ; Buil d listman  dislay
  5621   "RTN","RCD PEE",261,0 )
  5622    ; Input:    ^TMP($J, "RCPM_LIST ,MATCHW,EF TSEQ)=A1^. ..^A11 Whe re:
  5623   "RTN","RCD PEE",262,0 )
  5624    ;                      MATCHW -  Weighted  number der ived from  partial ma tches
  5625   "RTN","RCD PEE",263,0 )
  5626    ;                      EFTSEQ -  Unique EF T Sequence  #
  5627   "RTN","RCD PEE",264,0 )
  5628    ;                      A1 - Num ber of mat ches betwe en the ERA  and the E FT
  5629   "RTN","RCD PEE",265,0 )
  5630    ;                      A2 - Pay er TIN # i f matched,  else ""
  5631   "RTN","RCD PEE",266,0 )
  5632    ;                      A3 - Pay er Trace #  if matche d, else ""
  5633   "RTN","RCD PEE",267,0 )
  5634    ;                      A4 - Tot al Amount  paid if ma tched else  ""
  5635   "RTN","RCD PEE",268,0 )
  5636    ;                      A5 - Mat ched weigh ted value
  5637   "RTN","RCD PEE",269,0 )
  5638    ;                           10  points for  a match o n Trace Nu mber
  5639   "RTN","RCD PEE",270,0 )
  5640    ;                            5  points for  a match o n Total Am ount
  5641   "RTN","RCD PEE",271,0 )
  5642    ;                            1  point for  a match on  TIN
  5643   "RTN","RCD PEE",272,0 )
  5644    ;                           Onl y matches  with a wei gted value  of 5 or m ore are di splayed
  5645   "RTN","RCD PEE",273,0 )
  5646    ;                      A6 - EFT  IEN
  5647   "RTN","RCD PEE",274,0 )
  5648    ;                      A7 - Dep osit #
  5649   "RTN","RCD PEE",275,0 )
  5650    ;                      A8 - Int ernal Depo sit Date
  5651   "RTN","RCD PEE",276,0 )
  5652    ;                      A9 - Pay er Name/TI N (max 58  characters )
  5653   "RTN","RCD PEE",277,0 )
  5654    ;                      A10- EFT  Trace #
  5655   "RTN","RCD PEE",278,0 )
  5656    ;                      A11- EFT  Total Amo unt Paid
  5657   "RTN","RCD PEE",279,0 )
  5658    N CTR,EFT SEQ,MATCH, MATCHW
  5659   "RTN","RCD PEE",280,0 )
  5660    S CTR=1
  5661   "RTN","RCD PEE",281,0 )
  5662    S VALMCNT =0
  5663   "RTN","RCD PEE",282,0 )
  5664    S MATCHW= ""
  5665   "RTN","RCD PEE",283,0 )
  5666    F  D  Q:M ATCHW=""
  5667   "RTN","RCD PEE",284,0 )
  5668    . S MATCH W=$O(^TMP( $J,"RCPM_L IST",MATCH W),-1)
  5669   "RTN","RCD PEE",285,0 )
  5670    . Q:MATCH W=""
  5671   "RTN","RCD PEE",286,0 )
  5672    . S EFTSE Q=""
  5673   "RTN","RCD PEE",287,0 )
  5674    . F  D  Q :EFTSEQ=""
  5675   "RTN","RCD PEE",288,0 )
  5676    . . S EFT SEQ=$O(^TM P($J,"RCPM _LIST",MAT CHW,EFTSEQ ))
  5677   "RTN","RCD PEE",289,0 )
  5678    . . Q:EFT SEQ=""
  5679   "RTN","RCD PEE",290,0 )
  5680    . . S MAT CH=^TMP($J ,"RCPM_LIS T",MATCHW, EFTSEQ)
  5681   "RTN","RCD PEE",291,0 )
  5682    . . D DIS PEFT(MATCH ,EFTSEQ,.C TR,.VALMCN T)
  5683   "RTN","RCD PEE",292,0 )
  5684    ;
  5685   "RTN","RCD PEE",293,0 )
  5686    K ^TMP($J ,"RCPM_LIS T")
  5687   "RTN","RCD PEE",294,0 )
  5688    S VALMSG= "Enter ??  for more a ctions and  help"
  5689   "RTN","RCD PEE",295,0 )
  5690    Q
  5691   "RTN","RCD PEE",296,0 )
  5692    ;
  5693   "RTN","RCD PEE",297,0 )
  5694   DISPEFT(MA TCH,EFTSEQ ,CTR,VALMC NT) ; Buil d the disp lay for on e EFT
  5695   "RTN","RCD PEE",298,0 )
  5696    ; Input:    MATCH        - A1^. ..^A11 Whe re:
  5697   "RTN","RCD PEE",299,0 )
  5698    ;                           A1  - Number o f matches  between th e ERA and  the EFT
  5699   "RTN","RCD PEE",300,0 )
  5700    ;                           A2  - Payer TI N # if mat ched, else  ""
  5701   "RTN","RCD PEE",301,0 )
  5702    ;                           A3  - Payer Tr ace # if m atched, el se ""
  5703   "RTN","RCD PEE",302,0 )
  5704    ;                           A4  - Total Am ount paid  if matched  else ""
  5705   "RTN","RCD PEE",303,0 )
  5706    ;                           A5  - Matched  weighted v alue
  5707   "RTN","RCD PEE",304,0 )
  5708    ;                                 10 point s for a ma tch on Tra ce Number
  5709   "RTN","RCD PEE",305,0 )
  5710    ;                                 5 points  for a mat ch on Tota l Amount
  5711   "RTN","RCD PEE",306,0 )
  5712    ;                                 1 point  for a matc h on TIN
  5713   "RTN","RCD PEE",307,0 )
  5714    ;                                 Only mat ches with  a weigted  value of 5  or more a re display ed
  5715   "RTN","RCD PEE",308,0 )
  5716    ;                           A6  - EFT IEN
  5717   "RTN","RCD PEE",309,0 )
  5718    ;                           A7  - Deposit  #
  5719   "RTN","RCD PEE",310,0 )
  5720    ;                           A8  - Internal  Deposit D ate
  5721   "RTN","RCD PEE",311,0 )
  5722    ;                           A9  - Payer Na me/TIN (ma x 58 chara cters)
  5723   "RTN","RCD PEE",312,0 )
  5724    ;                           A10 - EFT Trac e #
  5725   "RTN","RCD PEE",313,0 )
  5726    ;                           A11 - EFT Tota l Amount P aid
  5727   "RTN","RCD PEE",314,0 )
  5728    ;           EFTSEQ       - Uniq ue EFT seq uence #
  5729   "RTN","RCD PEE",315,0 )
  5730    ;           CTR          - Curr ent EFT co unter
  5731   "RTN","RCD PEE",316,0 )
  5732    ;           VALMCNT      - Curr ent Listma n body lin e counter
  5733   "RTN","RCD PEE",317,0 )
  5734    ; Output:   CTR          - Upda ted EFT co unter
  5735   "RTN","RCD PEE",318,0 )
  5736    ;           VALMCNT      - Upda ted Listma n body lin e counter
  5737   "RTN","RCD PEE",319,0 )
  5738    N EFTIEN, X,XX,TT
  5739   "RTN","RCD PEE",320,0 )
  5740    S EFTIEN= $P(MATCH," ^",6)                     ; EFT  IEN
  5741   "RTN","RCD PEE",321,0 )
  5742    ;
  5743   "RTN","RCD PEE",322,0 )
  5744    ; Build f irst displ ay line of  the EFT
  5745   "RTN","RCD PEE",323,0 )
  5746    S YY=$P(M ATCH,"^",1 0) ; Trace  Number
  5747   "RTN","RCD PEE",324,0 )
  5748    S X=$E(CT R_$J("",4) ,1,4)_" "_ $E(EFTSEQ_ $J("",10), 1,10)_" "_ $E(YY_$J(" ",50),1,50 )
  5749   "RTN","RCD PEE",325,0 )
  5750    S X=X_" " _$J($P(MAT CH,"^",11) ,12,2) ; T otal Amoun t Paid
  5751   "RTN","RCD PEE",326,0 )
  5752    D SET(X,C TR,EFTIEN, .VALMCNT)
  5753   "RTN","RCD PEE",327,0 )
  5754    ;
  5755   "RTN","RCD PEE",328,0 )
  5756    ; Build s econd disp lay line o f the EFT
  5757   "RTN","RCD PEE",329,0 )
  5758    S XX=$P(M ATCH,"^",9 )
  5759   "RTN","RCD PEE",330,0 )
  5760    S X="      "_$E(XX_$ J("",73),1 ,73) ; Pay er Name/TI N
  5761   "RTN","RCD PEE",331,0 )
  5762    D SET(X,C TR,EFTIEN, .VALMCNT)
  5763   "RTN","RCD PEE",332,0 )
  5764    D SET(" " ,CTR,"",.V ALMCNT) ;  Display bl ank line
  5765   "RTN","RCD PEE",333,0 )
  5766    S CTR=CTR +1
  5767   "RTN","RCD PEE",334,0 )
  5768    S VALMSG= "Enter ??  for more a ctions and  help"
  5769   "RTN","RCD PEE",335,0 )
  5770    Q
  5771   "RTN","RCD PEE",336,0 )
  5772    ;
  5773   "RTN","RCD PEE",337,0 )
  5774   SET(X,RCSE Q,EFTIEN,V ALMCNT) ;  Set listma n body and  selection  arrays
  5775   "RTN","RCD PEE",338,0 )
  5776    ; Input:    X                                  - Data  to set in to the dis play line
  5777   "RTN","RCD PEE",339,0 )
  5778    ;           RCSEQ                              - Sele ctable lin e #
  5779   "RTN","RCD PEE",340,0 )
  5780    ;           EFTIEN                             - IEN  of the EFT  record (# 344.31)
  5781   "RTN","RCD PEE",341,0 )
  5782    ;           VALMCNT                            - Curr ent Displa y line cou nter
  5783   "RTN","RCD PEE",342,0 )
  5784    ;           ^TMP("RC PM-WL",$J)                - Curr ent global  array of  body displ ay lines
  5785   "RTN","RCD PEE",343,0 )
  5786    ;           ^TMP("RC PM-WL_WLDX ",$J,RCSEQ )   -VALMC NT_"^"_EFT IEN
  5787   "RTN","RCD PEE",344,0 )
  5788    ; Output:   VALMCNT                            - Upda ted Displa y line cou nter
  5789   "RTN","RCD PEE",345,0 )
  5790    ;           ^TMP("RC PM--WL",$J ,VALMCNT,0 )   - Upda ted displa y lines wi th new lin e
  5791   "RTN","RCD PEE",346,0 )
  5792    ;           ^TMP("RC PM-WL_WLDX ",$J,RCSEQ )   -VALMC NT_"^"_ERA IEN
  5793   "RTN","RCD PEE",347,0 )
  5794    S VALMCNT =VALMCNT+1 ,^TMP("RCP M-WL",$J,V ALMCNT,0)= X
  5795   "RTN","RCD PEE",348,0 )
  5796    S:$G(RCSE Q) ^TMP("R CPM-WL",$J ,"IDX",VAL MCNT,RCSEQ )=$G(EFTIE N)
  5797   "RTN","RCD PEE",349,0 )
  5798    S:$G(EFTI EN) ^TMP(" RCPM-WL_WL DX",$J,RCS EQ)=VALMCN T_"^"_EFTI EN
  5799   "RTN","RCD PEE",350,0 )
  5800    Q
  5801   "RTN","RCD PEE",351,0 )
  5802    ;
  5803   "RTN","RCD PEE",352,0 )
  5804   HELP ;EP f rom listma n template  RCDPE EFT  PARTIAL M ATCH
  5805   "RTN","RCD PEE",353,0 )
  5806    ; help co de
  5807   "RTN","RCD PEE",354,0 )
  5808    S X="?" D  DISP^XQOR M1 W !!
  5809   "RTN","RCD PEE",355,0 )
  5810    Q
  5811   "RTN","RCD PEE",356,0 )
  5812    ;
  5813   "RTN","RCD PEE",357,0 )
  5814   EXIT ;EP f rom listma n template  RCDPE EFT  PARTIAL M ATCH
  5815   "RTN","RCD PEE",358,0 )
  5816    ; Exit co de
  5817   "RTN","RCD PEE",359,0 )
  5818    K ^TMP("R CPM_PARAMS ",$J),^TMP ("RCDPEU1" ,$J)
  5819   "RTN","RCD PEE",360,0 )
  5820    K ^TMP("R CPM-WL",$J ),^TMP("RC PM-WL_WLDX ",$J),^TMP ($J,"RCPM_ LIST")
  5821   "RTN","RCD PEE",361,0 )
  5822    Q
  5823   "RTN","RCD PEE",362,0 )
  5824    ;
  5825   "RTN","RCD PEE",363,0 )
  5826   SELEFT ;EP  from RCDP E EFT PART IAL MATCH  SELECT
  5827   "RTN","RCD PEE",364,0 )
  5828    ; Input:  None
  5829   "RTN","RCD PEE",365,0 )
  5830    ; Output:  ^TMP($J," SELEFT")-E FTIEN if a n EFT was  selected
  5831   "RTN","RCD PEE",366,0 )
  5832    N PCNT,PR OMPT,RCEFT ,SEL
  5833   "RTN","RCD PEE",367,0 )
  5834    D FULL^VA LM1
  5835   "RTN","RCD PEE",368,0 )
  5836    S VALM("E NTITY")="# "
  5837   "RTN","RCD PEE",369,0 )
  5838    D EN^VALM 2($G(XQORN OD(0)),"S" )
  5839   "RTN","RCD PEE",370,0 )
  5840    S PCNT=$O (VALMY(0))
  5841   "RTN","RCD PEE",371,0 )
  5842    Q:'PCNT
  5843   "RTN","RCD PEE",372,0 )
  5844    S RCEFT=$ P(^TMP("RC PM-WL_WLDX ",$J,PCNT) ,"^",2)
  5845   "RTN","RCD PEE",373,0 )
  5846    Q:RCEFT=" "
  5847   "RTN","RCD PEE",374,0 )
  5848    S VALMBCK ="R"
  5849   "RTN","RCD PEE",375,0 )
  5850    S RCQUIT= $$SHOWM(RC EFT)
  5851   "RTN","RCD PEE",376,0 )
  5852    I RCQUIT  S VALMBCK= "Q"
  5853   "RTN","RCD PEE",377,0 )
  5854    Q
  5855   "RTN","RCD PEE",378,0 )
  5856    ;
  5857   "RTN","RCD PEE",379,0 )
  5858   SHOWM(RCEF T) ; Show  EFT detail s and ask  user if th is is the  correct on e
  5859   "RTN","RCD PEE",380,0 )
  5860    ; Input :  RCEFT - I EN of EFT  from file  344.31
  5861   "RTN","RCD PEE",381,0 )
  5862    ; Returns  : 1 - If  match was  made, 0 -  to refresh  patial ma tch list,  -1 to exit
  5863   "RTN","RCD PEE",382,0 )
  5864    ;
  5865   "RTN","RCD PEE",383,0 )
  5866    N DEPDT,D EPNUM,RCQU IT
  5867   "RTN","RCD PEE",384,0 )
  5868    D GETDINF O^RCDPEM2( RCEFT,.DEP NUM,.DEPDT )
  5869   "RTN","RCD PEE",385,0 )
  5870    W !
  5871   "RTN","RCD PEE",386,0 )
  5872    S DIC="^R CY(344.31, ",DR="0",D A=RCEFT D  EN^DIQ
  5873   "RTN","RCD PEE",387,0 )
  5874    W "  DEPO SIT NUMBER : ",DEPNUM ,?40,"DEPO SIT DATE:  ",DEPDT
  5875   "RTN","RCD PEE",388,0 )
  5876    W !
  5877   "RTN","RCD PEE",389,0 )
  5878    S DIR("A" )="ARE YOU  SURE THIS  IS THE EF T YOU WANT  TO MATCH? : ",DIR(0) ="YA",DIR( "B")="YES"  D ^DIR K  DIR
  5879   "RTN","RCD PEE",390,0 )
  5880    I $D(DUOU T)!$D(DTOU T) S RCQUI T=1 Q -1
  5881   "RTN","RCD PEE",391,0 )
  5882    I Y'=1 Q  0 ; G ML1   CJE*4.5*3 32
  5883   "RTN","RCD PEE",392,0 )
  5884    ; Go to t he Manual  match, we  have the E RA and EFT
  5885   "RTN","RCD PEE",393,0 )
  5886    S RCQUIT= 0
  5887   "RTN","RCD PEE",394,0 )
  5888    D M12A^RC DPEM2
  5889   "RTN","RCD PEE",395,0 )
  5890    I RCQUIT  Q -1
  5891   "RTN","RCD PEE",396,0 )
  5892    Q 1
  5893   "RTN","RCD PEFTL")
  5894   0^3^B84961 666
  5895   "RTN","RCD PEFTL",1,0 )
  5896   RCDPEFTL ; EDE/FA - L IST LOCKED  EFT REPOR T ;18 July  2018 11:1 9:25
  5897   "RTN","RCD PEFTL",2,0 )
  5898    ;;4.5;Acc ounts Rece ivable;**3 32**;Mar 2 0, 1995;Bu ild 34
  5899   "RTN","RCD PEFTL",3,0 )
  5900    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  5901   "RTN","RCD PEFTL",4,0 )
  5902    ;
  5903   "RTN","RCD PEFTL",5,0 )
  5904   EN ; Entry  from RCDP E EFT OVER RIDE REPOR T option
  5905   "RTN","RCD PEFTL",6,0 )
  5906    N RCINPT, RCVAL
  5907   "RTN","RCD PEFTL",7,0 )
  5908    K ^TMP("R CDPE_EFTL" ,$J)
  5909   "RTN","RCD PEFTL",8,0 )
  5910    ;
  5911   "RTN","RCD PEFTL",9,0 )
  5912    ; Warn if  override  set today  or not
  5913   "RTN","RCD PEFTL",10, 0)
  5914    S RCVAL(" OverRide") =+$$GET1^D IQ(344.61, 1,20,"I")  ; (#20) ME DICAL EFT  OVERRIDE [ 1D]
  5915   "RTN","RCD PEFTL",11, 0)
  5916    W !,"Medi cal Overri de "_$S($P (RCVAL("Ov erRide")," .")=DT:"", 1:"not ")_ "active fo r today's  date"
  5917   "RTN","RCD PEFTL",12, 0)
  5918    ;
  5919   "RTN","RCD PEFTL",13, 0)
  5920    S RCVAL(" EFTPostLim it")=+$$GE T1^DIQ(344 .61,1,.06)  ; (#.06)  MEDICAL EF T POST PRE VENT DAYS  [6N]
  5921   "RTN","RCD PEFTL",14, 0)
  5922    S RCVAL(" CutoffDate ")=$$FMADD ^XLFDT(DT, -RCVAL("EF TPostLimit ")) ; Toda y's date l ess post p revent day s
  5923   "RTN","RCD PEFTL",15, 0)
  5924    W !,"Aged  EFT days  before Med ical posti ng prevent ed = "_RCV AL("EFTPos tLimit"),!
  5925   "RTN","RCD PEFTL",16, 0)
  5926    ;
  5927   "RTN","RCD PEFTL",17, 0)
  5928    ; Check i f any medi cal unpost ed EFTs ex ist with a ged days g reater tha n site par ameter val ue
  5929   "RTN","RCD PEFTL",18, 0)
  5930    S RCVAL(" 1stEFTDate ")=$$GETFR ST(RCVAL(" EFTPostLim it"),RCVAL ("CutoffDa te"))
  5931   "RTN","RCD PEFTL",19, 0)
  5932    ;
  5933   "RTN","RCD PEFTL",20, 0)
  5934    ; If none  stop
  5935   "RTN","RCD PEFTL",21, 0)
  5936    I 'RCVAL( "1stEFTDat e") D  Q
  5937   "RTN","RCD PEFTL",22, 0)
  5938    . N DIR
  5939   "RTN","RCD PEFTL",23, 0)
  5940    . S DIR(0 )="EA"
  5941   "RTN","RCD PEFTL",24, 0)
  5942    . S DIR(" A",1)="The  system do es not hav e any aged , unposted  EFTs."
  5943   "RTN","RCD PEFTL",25, 0)
  5944    . S DIR(" A",2)=" "
  5945   "RTN","RCD PEFTL",26, 0)
  5946    . S DIR(" A")="Press  ENTER to  continue:  "
  5947   "RTN","RCD PEFTL",27, 0)
  5948    . D ^DIR
  5949   "RTN","RCD PEFTL",28, 0)
  5950    ;
  5951   "RTN","RCD PEFTL",29, 0)
  5952    ; report  parameters
  5953   "RTN","RCD PEFTL",30, 0)
  5954    S RCINPT( "DateRange ")=RCVAL(" 1stEFTDate ")_":"_RCV AL("Cutoff Date")  ;  Start Date :End date
  5955   "RTN","RCD PEFTL",31, 0)
  5956    S RCINPT( "2Excel?") =$$ASKXCEL   ; Ask to  output to  Excel
  5957   "RTN","RCD PEFTL",32, 0)
  5958    Q:RCINPT( "2Excel?") =-1  ; '^'  or timeou t
  5959   "RTN","RCD PEFTL",33, 0)
  5960    D:RCINPT( "2Excel?") =1 INFO^RC DPEM6  ; D isplay cap ture infor mation for  Excel
  5961   "RTN","RCD PEFTL",34, 0)
  5962    S RCINPT( "DeviceSel ected?")=$ $DEVICE(RC INPT("2Exc el?"))  ;  Ask output  device
  5963   "RTN","RCD PEFTL",35, 0)
  5964    Q:'RCINPT ("DeviceSe lected?")   ; '^' or  timeout (P OP from %Z IS call)
  5965   "RTN","RCD PEFTL",36, 0)
  5966    ; done wi th user qu estions
  5967   "RTN","RCD PEFTL",37, 0)
  5968    S RCINPT( "AgedDays" )=RCVAL("E FTPostLimi t")  ; all owed aged  days for r eport
  5969   "RTN","RCD PEFTL",38, 0)
  5970    S RCINPT( "1stEFT")= RCVAL("1st EFTDate")   ; first E FT date fo r report
  5971   "RTN","RCD PEFTL",39, 0)
  5972    ; Medical  EFT Overr ide parame ters
  5973   "RTN","RCD PEFTL",40, 0)
  5974    S RCINPT( 344.61,20) =$$GET1^DI Q(344.61,1 _",",20,"E ")  ; (#20 ) MEDICAL  EFT OVERRI DE [1D]
  5975   "RTN","RCD PEFTL",41, 0)
  5976    S RCINPT( 344.61,22) =$$GET1^DI Q(344.61,1 _",",22,"E ")  ; (#22 ) USER - M EDICAL OVE RRIDE [3P: 200]
  5977   "RTN","RCD PEFTL",42, 0)
  5978    S RCINPT( 344.61,24) =$$GET1^DI Q(344.61,1 _",",24,"E ")  ; (#24 ) COMMENT  - MEDICAL  OVERRIDE [ 5F]
  5979   "RTN","RCD PEFTL",43, 0)
  5980    ; Queue o utput
  5981   "RTN","RCD PEFTL",44, 0)
  5982    I $D(IO(" Q")) D  D  HOME^%ZIS  Q
  5983   "RTN","RCD PEFTL",45, 0)
  5984    . N ZTDES C,ZTRTN,ZT SAVE,ZTSK
  5985   "RTN","RCD PEFTL",46, 0)
  5986    . S ZTRTN ="REPORT^R CDPEFTL(.R CINPT)",ZT DESC="RCDP E EFT OVER RIDE REPOR T"
  5987   "RTN","RCD PEFTL",47, 0)
  5988    . S ZTSAV E("RC*")=" ",ZTSAVE(" IO*")="" D  ^%ZTLOAD
  5989   "RTN","RCD PEFTL",48, 0)
  5990    . W !!,$S ($D(ZTSK): "Task numb er "_ZTSK_ " was queu ed.",1:"Un able to qu eue this t ask.")
  5991   "RTN","RCD PEFTL",49, 0)
  5992    . K IO("Q ")
  5993   "RTN","RCD PEFTL",50, 0)
  5994    ;
  5995   "RTN","RCD PEFTL",51, 0)
  5996    D REPORT( .RCINPT)
  5997   "RTN","RCD PEFTL",52, 0)
  5998    Q
  5999   "RTN","RCD PEFTL",53, 0)
  6000    ;
  6001   "RTN","RCD PEFTL",54, 0)
  6002   REPORT(RCI NPT) ; ent ry point f rom TaskMa n and abov e
  6003   "RTN","RCD PEFTL",55, 0)
  6004    D RPTCOMP (.RCINPT)   ; Compile  report
  6005   "RTN","RCD PEFTL",56, 0)
  6006    D RPTOUT( .RCINPT)   ; Output r eport
  6007   "RTN","RCD PEFTL",57, 0)
  6008    I '$D(ZTQ UEUED) D ^ %ZISC  ;if  not queue d Close de vice
  6009   "RTN","RCD PEFTL",58, 0)
  6010    I $D(ZTQU EUED) S ZT REQ="@"
  6011   "RTN","RCD PEFTL",59, 0)
  6012    K ^TMP("R CDPE_EFTL" ,$J)
  6013   "RTN","RCD PEFTL",60, 0)
  6014    K ZTQUEUE D
  6015   "RTN","RCD PEFTL",61, 0)
  6016    Q
  6017   "RTN","RCD PEFTL",62, 0)
  6018    ;
  6019   "RTN","RCD PEFTL",63, 0)
  6020   RPTCOMP(RC INPT) ; Fu ll EFT sca n to compi le report
  6021   "RTN","RCD PEFTL",64, 0)
  6022    ; Input:
  6023   "RTN","RCD PEFTL",65, 0)
  6024    ;  RCINPT ("DateRang e")= Repor t start da te:Report  end date
  6025   "RTN","RCD PEFTL",66, 0)
  6026    ; Output:
  6027   "RTN","RCD PEFTL",67, 0)
  6028    ;  ^TMP(" RCDPE_EFTL ",$J) - co mpilation  of report  data
  6029   "RTN","RCD PEFTL",68, 0)
  6030    ;
  6031   "RTN","RCD PEFTL",69, 0)
  6032    N END,RCE FT,RECVDT
  6033   "RTN","RCD PEFTL",70, 0)
  6034    ; RCEFT -  array for  EFT data,  counter,  IEN
  6035   "RTN","RCD PEFTL",71, 0)
  6036    ;
  6037   "RTN","RCD PEFTL",72, 0)
  6038    ; Initial ize report
  6039   "RTN","RCD PEFTL",73, 0)
  6040    K ^TMP("R CDPE_EFTL" ,$J)
  6041   "RTN","RCD PEFTL",74, 0)
  6042    S RCEFT(" Count")=0, ^TMP("RCDP E_EFTL",$J ,"EFT coun t")=0,^TMP ("RCDPE_EF TL",$J,"To tal Amt")= 0
  6043   "RTN","RCD PEFTL",75, 0)
  6044    S RECVDT= $P(RCINPT( "DateRange "),":")-.1   ; start  date minus  fraction
  6045   "RTN","RCD PEFTL",76, 0)
  6046    S END=$P( RCINPT("Da teRange"), ":",2) ; r eport endi ng date ra nge
  6047   "RTN","RCD PEFTL",77, 0)
  6048    ; File #3 44.31 Trad itional Cr oss-Refere nce: "ADR" , REGULAR    Field:   DATE RECEI VED  (344. 31,.13)
  6049   "RTN","RCD PEFTL",78, 0)
  6050    ; Scan EF T received  date inde x for days
  6051   "RTN","RCD PEFTL",79, 0)
  6052    F  S RECV DT=$O(^RCY (344.31,"A DR",RECVDT )) Q:'RECV DT  Q:RECV DT>END  D
  6053   "RTN","RCD PEFTL",80, 0)
  6054    . S RCEFT ("IEN")=""
  6055   "RTN","RCD PEFTL",81, 0)
  6056    . ; Scan  individual  EFTs
  6057   "RTN","RCD PEFTL",82, 0)
  6058    . F  S RC EFT("IEN") =$O(^RCY(3 44.31,"ADR ",RECVDT,R CEFT("IEN" ))) Q:'RCE FT("IEN")   D
  6059   "RTN","RCD PEFTL",83, 0)
  6060    ..  ; Che ck this is  a valid E FT type
  6061   "RTN","RCD PEFTL",84, 0)
  6062    ..  Q:'$$ VALID(RCEF T("IEN"))
  6063   "RTN","RCD PEFTL",85, 0)
  6064    ..  ; cal culate age d number o f days of  the EFT
  6065   "RTN","RCD PEFTL",86, 0)
  6066    ..  S RCE FT("DaysAg ed")=$$FMD IFF^XLFDT( DT,RECVDT)  ; get age d number o f days of  the EFT
  6067   "RTN","RCD PEFTL",87, 0)
  6068    ..  Q:RCE FT("DaysAg ed")'>RCVA L("EFTPost Limit")  ;  Ignore Un posted EFT  younger t han aged d ays maximu m
  6069   "RTN","RCD PEFTL",88, 0)
  6070    ..  S RCE FT("Trace# ")=$$GET1^ DIQ(344.31 ,RCEFT("IE N"),.04)   ;(#.04) TR ACE # [4F]  
  6071   "RTN","RCD PEFTL",89, 0)
  6072    ..  S RCE FT("MatchS tatus")=$$ GET1^DIQ(3 44.31,RCEF T("IEN"),. 08,"E")  ; (#.08) MAT CH STATUS  [8S]
  6073   "RTN","RCD PEFTL",90, 0)
  6074    ..  S RCE FT("Trans# ")=$$GET1^ DIQ(344.31 ,RCEFT("IE N"),.01,"E ") ;(#.01)  EFT TRANS ACTION [1P :344.3]
  6075   "RTN","RCD PEFTL",91, 0)
  6076    ..  S RCE FT("ERARec ord")=$$GE T1^DIQ(344 .31,RCEFT( "IEN"),.1)   ;(#.1) E RA RECORD  [10P:344.4 ]
  6077   "RTN","RCD PEFTL",92, 0)
  6078    ..  S:RCE FT("ERARec ord")="" R CEFT("ERAR ecord")="N one"
  6079   "RTN","RCD PEFTL",93, 0)
  6080    ..  S RCE FT("Amount ")=$$GET1^ DIQ(344.31 ,RCEFT("IE N"),.07)   ;(#.07) AM OUNT OF PA YMENT [7N]
  6081   "RTN","RCD PEFTL",94, 0)
  6082    ..  ; Sav e EFT deta il and upd ate totals  for repor t
  6083   "RTN","RCD PEFTL",95, 0)
  6084    ..  S RCE FT("Count" )=RCEFT("C ount")+1
  6085   "RTN","RCD PEFTL",96, 0)
  6086    ..  S ^TM P("RCDPE_E FTL",$J,RC EFT("Count "))=RCEFT( "Trans#")_ U_RCEFT("M atchStatus ")_U_RCEFT ("DaysAged ")_U_RCEFT ("ERARecor d")_U_RECV DT_U_RCEFT ("Amount") _U_RCEFT(" Trace#")
  6087   "RTN","RCD PEFTL",97, 0)
  6088    ..  S ^TM P("RCDPE_E FTL",$J,"E FT count") =RCEFT("Co unt")
  6089   "RTN","RCD PEFTL",98, 0)
  6090    ..  S ^TM P("RCDPE_E FTL",$J,"T otal Amt") =^TMP("RCD PE_EFTL",$ J,"Total A mt")+RCEFT ("Amount")
  6091   "RTN","RCD PEFTL",99, 0)
  6092    ;
  6093   "RTN","RCD PEFTL",100 ,0)
  6094    Q
  6095   "RTN","RCD PEFTL",101 ,0)
  6096    ;
  6097   "RTN","RCD PEFTL",102 ,0)
  6098   RPTOUT(RCI NPT) ; Out put the re port to pa per/screen  or excel
  6099   "RTN","RCD PEFTL",103 ,0)
  6100    ; Input:  RCINPT 
  6101   "RTN","RCD PEFTL",104 ,0)
  6102    ; Output:  OUTPUT
  6103   "RTN","RCD PEFTL",105 ,0)
  6104    N A,B,DAT A,RCRPRT
  6105   "RTN","RCD PEFTL",106 ,0)
  6106    ; RCRPRT  - array us ed for rep ort
  6107   "RTN","RCD PEFTL",107 ,0)
  6108    S RCRPRT( "LineCount ")=0,RCRPR T("Page")= 1 ; Initia lize Line/ Page count ers
  6109   "RTN","RCD PEFTL",108 ,0)
  6110    S RCRPRT( "RunDate") =$$FMTE^XL FDT($$NOW^ XLFDT)
  6111   "RTN","RCD PEFTL",109 ,0)
  6112    S RCRPRT( "ExcelFrmt ?")=RCINPT ("2Excel?" )
  6113   "RTN","RCD PEFTL",110 ,0)
  6114    S RCRPRT( "Exit")=0, RCRPRT("Li stCntr")=0
  6115   "RTN","RCD PEFTL",111 ,0)
  6116    ; create  lines 2-4  in the hea der
  6117   "RTN","RCD PEFTL",112 ,0)
  6118    S RCRPRT( "HeaderLin e",2)="Sor ted by Age d Days, Co mment: "_$ S(RCINPT(3 44.61,24)] "":RCINPT( 344.61,24) ,1:"None")
  6119   "RTN","RCD PEFTL",113 ,0)
  6120    ; place u ser's name  on the ri ght edge o f line 3
  6121   "RTN","RCD PEFTL",114 ,0)
  6122    S A="Medi cal Overri de Date: " _$S(RCINPT (344.61,20 )]"":RCINP T(344.61,2 0),1:"None "),B=" Use r: "_$S(RC INPT(344.6 1,22)]"":R CINPT(344. 61,22),1:" None"),$E( A,IOM-$L(B )+1,IOM)=B
  6123   "RTN","RCD PEFTL",115 ,0)
  6124    S RCRPRT( "HeaderLin e",3)=A
  6125   "RTN","RCD PEFTL",116 ,0)
  6126    S RCRPRT( "HeaderLin e",4)="Num ber of Day s (Age) of  Unposted  EFTs to pr event post ing: "_$$G ET1^DIQ(34 4.61,1,.06 )
  6127   "RTN","RCD PEFTL",117 ,0)
  6128    S RCRPRT( "HeaderBor der")=$TR( $J(" ",IOM -1)," ","= ")  ; row  of equal s igns for b order
  6129   "RTN","RCD PEFTL",118 ,0)
  6130    I RCRPRT( "ExcelFrmt ?") W !,"E FT^Match S tatus^Aged  Days^ERA  #^Date Rec eived^Amou nt^Trace # "
  6131   "RTN","RCD PEFTL",119 ,0)
  6132    I 'RCRPRT ("ExcelFrm t?") D RPT HDR(.RCRPR T),RPTTOT  S RCRPRT(" LineCount" )=11
  6133   "RTN","RCD PEFTL",120 ,0)
  6134    ;
  6135   "RTN","RCD PEFTL",121 ,0)
  6136    F  S RCRP RT("ListCn tr")=$O(^T MP("RCDPE_ EFTL",$J,R CRPRT("Lis tCntr")))  Q:'RCRPRT( "ListCntr" )  D  Q:RC RPRT("Exit ")
  6137   "RTN","RCD PEFTL",122 ,0)
  6138    . S DATA= $G(^TMP("R CDPE_EFTL" ,$J,RCRPRT ("ListCntr ")))
  6139   "RTN","RCD PEFTL",123 ,0)
  6140    . ; Outpu t lines fo r one EFT
  6141   "RTN","RCD PEFTL",124 ,0)
  6142    . S RCRPR T("Exit")= $$RPRT1EFT (DATA,.RCR PRT)
  6143   "RTN","RCD PEFTL",125 ,0)
  6144    ;
  6145   "RTN","RCD PEFTL",126 ,0)
  6146    I 'RCRPRT ("ExcelFrm t?") W:'RC RPRT("Exit ") !,RCRPR T("HeaderB order"),!, $$ENDORPRT ^RCDPEARL
  6147   "RTN","RCD PEFTL",127 ,0)
  6148    I RCRPRT( "ExcelFrmt ?"),$E(IOS T,1,2)="C- " D  ; if  Excel form at and use r terminal , pause
  6149   "RTN","RCD PEFTL",128 ,0)
  6150    . N DIR S  DIR(0)="E A",DIR("A" )="Press E NTER to co ntinue: ", DIR("A",1) =" " D ^DI R
  6151   "RTN","RCD PEFTL",129 ,0)
  6152    Q
  6153   "RTN","RCD PEFTL",130 ,0)
  6154    ;
  6155   "RTN","RCD PEFTL",131 ,0)
  6156   RPRT1EFT(D ATA,RCRPRT ) ; boolea n function , Output o ne EFT rec ord
  6157   "RTN","RCD PEFTL",132 ,0)
  6158    ; Input: 
  6159   "RTN","RCD PEFTL",133 ,0)
  6160    ; DATA -  EFT to wri te, See RE PORT for a  complete  descriptio n
  6161   "RTN","RCD PEFTL",134 ,0)
  6162    ; RCRPRT( "ExcelFrmt ?"): zero  - formatte d Output t o Screen / printer
  6163   "RTN","RCD PEFTL",135 ,0)
  6164    ;         1 - Output  in Excel  format
  6165   "RTN","RCD PEFTL",136 ,0)
  6166    ; RCRPRT( "LineCount ") - Line  Count
  6167   "RTN","RCD PEFTL",137 ,0)
  6168    ; RCRPRT( "Page") -  Page Count
  6169   "RTN","RCD PEFTL",138 ,0)
  6170    ; Output:  
  6171   "RTN","RCD PEFTL",139 ,0)
  6172    ; RCRPRT( "LineCount ") - Updat ed Line Co unt
  6173   "RTN","RCD PEFTL",140 ,0)
  6174    ; RCRPRT( "Page") -  Updated Pa ge Count
  6175   "RTN","RCD PEFTL",141 ,0)
  6176    ; Returns :
  6177   "RTN","RCD PEFTL",142 ,0)
  6178    ;  1 if u ser indica tes to qui t, 0 other wise
  6179   "RTN","RCD PEFTL",143 ,0)
  6180    N STOP
  6181   "RTN","RCD PEFTL",144 ,0)
  6182    I RCRPRT( "ExcelFrmt ?") D  Q 0   ; Excel  output, fo rmat date  received,  write reco rd and qui t
  6183   "RTN","RCD PEFTL",145 ,0)
  6184    . N X,Y S  Y=DATA,X= $$FMTE^XLF DT($P(DATA ,U,5),"5DZ "),$P(Y,U, 5)=X
  6185   "RTN","RCD PEFTL",146 ,0)
  6186    . S RCRPR T("LineCou nt")=RCRPR T("LineCou nt")+1 W ! ,Y
  6187   "RTN","RCD PEFTL",147 ,0)
  6188    ; screen  /printer o utput
  6189   "RTN","RCD PEFTL",148 ,0)
  6190    S STOP=0   ; stop ou tput flag
  6191   "RTN","RCD PEFTL",149 ,0)
  6192    I $E(IOST ,1,2)="C-" ,'(RCRPRT( "LineCount ")+3<IOSL)  D  ; bott om of scre en logic,  must be "C -" device  subtype
  6193   "RTN","RCD PEFTL",150 ,0)
  6194    . S STOP= $$PGEND Q: STOP
  6195   "RTN","RCD PEFTL",151 ,0)
  6196    . S RCRPR T("Page")= RCRPRT("Pa ge")+1 D R PTHDR(.RCR PRT) S RCR PRT("LineC ount")=8
  6197   "RTN","RCD PEFTL",152 ,0)
  6198    ;
  6199   "RTN","RCD PEFTL",153 ,0)
  6200    Q:STOP 1   ; user in dicated to  stop
  6201   "RTN","RCD PEFTL",154 ,0)
  6202    S RCRPRT( "LineCount ")=RCRPRT( "LineCount ")+3
  6203   "RTN","RCD PEFTL",155 ,0)
  6204    W !,$$PAD ($P(DATA,U ),9)_$P(DA TA,U,7)  ;  EFT numbe r & Trace  #
  6205   "RTN","RCD PEFTL",156 ,0)
  6206    ; ; ERA n umber, Mat ch Status,  EFT Recei ved Date,  Aged Days,  Amount
  6207   "RTN","RCD PEFTL",157 ,0)
  6208    W !,$$PAD (" "_$P(DA TA,U,4),10 )_$$PAD($P (DATA,U,2) ,20)_$$PAD ($$FMTE^XL FDT($P(DAT A,U,5)),15 )_$$PAD($P (DATA,U,3) ,10)_"$"_$ FN($P(DATA ,U,6),",", 2),!
  6209   "RTN","RCD PEFTL",158 ,0)
  6210    ;
  6211   "RTN","RCD PEFTL",159 ,0)
  6212    Q 0  ; re turn false , continue  writing r eport
  6213   "RTN","RCD PEFTL",160 ,0)
  6214    ;
  6215   "RTN","RCD PEFTL",161 ,0)
  6216   RPTHDR(RCR PRT) ; rep ort header , line 1 i s dynamic
  6217   "RTN","RCD PEFTL",162 ,0)
  6218    N A,B
  6219   "RTN","RCD PEFTL",163 ,0)
  6220    S A="Pend ing EFT Ov erride Rep ort - Page  "_RCRPRT( "Page")_"  ",B=" Run  Date: "_RC RPRT("RunD ate"),$E(A ,IOM-$L(B) +1,IOM)=B
  6221   "RTN","RCD PEFTL",164 ,0)
  6222    W !,A,!,R CRPRT("Hea derLine",2 ),!,RCRPRT ("HeaderLi ne",3),!,R CRPRT("Hea derLine",4 )
  6223   "RTN","RCD PEFTL",165 ,0)
  6224    W !!,"EFT     Trace# ",!," ERA      Match  Status         EFT Re ceived     Aged        Amount"
  6225   "RTN","RCD PEFTL",166 ,0)
  6226    W !,RCRPR T("HeaderB order")
  6227   "RTN","RCD PEFTL",167 ,0)
  6228    Q
  6229   "RTN","RCD PEFTL",168 ,0)
  6230    ;
  6231   "RTN","RCD PEFTL",169 ,0)
  6232   RPTTOT ; D isplay rep ort totals
  6233   "RTN","RCD PEFTL",170 ,0)
  6234    W !,"Tota l Number o f Unposted  EFTs: "_$ G(^TMP("RC DPE_EFTL", $J,"EFT co unt"))
  6235   "RTN","RCD PEFTL",171 ,0)
  6236    W !,"Tota l Amount o f Unposted  EFTs: $"_ $FN($G(^TM P("RCDPE_E FTL",$J,"T otal Amt") ),",",2)
  6237   "RTN","RCD PEFTL",172 ,0)
  6238    W !,RCRPR T("HeaderB order")
  6239   "RTN","RCD PEFTL",173 ,0)
  6240    Q
  6241   "RTN","RCD PEFTL",174 ,0)
  6242    ;
  6243   "RTN","RCD PEFTL",175 ,0)
  6244   PGEND() ;  boolean fu nction, en d-of-page,  Ask to co ntinue
  6245   "RTN","RCD PEFTL",176 ,0)
  6246    ; Input:  IOST - Dev ice Type
  6247   "RTN","RCD PEFTL",177 ,0)
  6248    ; Returns : 1 - User  wants to  quit, 0 ot herwise
  6249   "RTN","RCD PEFTL",178 ,0)
  6250    Q:'($E(IO ST,1,2)="C -") 0  ; N ot a termi nal
  6251   "RTN","RCD PEFTL",179 ,0)
  6252    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
  6253   "RTN","RCD PEFTL",180 ,0)
  6254    S DIR(0)= "EA",DIR(" A")="Press  ENTER to  continue,  '^' to exi t: " D ^DI R
  6255   "RTN","RCD PEFTL",181 ,0)
  6256    I ($D(DIR UT))!($D(D UOUT)) Q 1   ; user e ntered '^'  or timeou t
  6257   "RTN","RCD PEFTL",182 ,0)
  6258    Q 0
  6259   "RTN","RCD PEFTL",183 ,0)
  6260    ;
  6261   "RTN","RCD PEFTL",184 ,0)
  6262   DEVICE(EXC EL) ; bool ean functi on to Sele ct output  device
  6263   "RTN","RCD PEFTL",185 ,0)
  6264    ; Input:  EXCEL - 1  - Ouput in  Excel for mat, 0 oth erwise
  6265   "RTN","RCD PEFTL",186 ,0)
  6266    ; Output:  IO,IOST a rrays in s ymbol tabl e
  6267   "RTN","RCD PEFTL",187 ,0)
  6268    ; Returns :
  6269   "RTN","RCD PEFTL",188 ,0)
  6270    ;   0 - N o device s elected, 1  otherwise
  6271   "RTN","RCD PEFTL",189 ,0)
  6272    N %ZIS,PO P S %ZIS=" QM" D ^%ZI S
  6273   "RTN","RCD PEFTL",190 ,0)
  6274    Q 'POP ;  return "no t POP"
  6275   "RTN","RCD PEFTL",191 ,0)
  6276    ;
  6277   "RTN","RCD PEFTL",192 ,0)
  6278   ASKXCEL()  ; Ask user  to export  to Excel
  6279   "RTN","RCD PEFTL",193 ,0)
  6280    ; Input:  None
  6281   "RTN","RCD PEFTL",194 ,0)
  6282    ; Returns : -1 - Use r up-arrow ed or time d out
  6283   "RTN","RCD PEFTL",195 ,0)
  6284    ;         zero - Out put to sel ected devi ce
  6285   "RTN","RCD PEFTL",196 ,0)
  6286    ;            1 - Out put to Exc el
  6287   "RTN","RCD PEFTL",197 ,0)
  6288    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
  6289   "RTN","RCD PEFTL",198 ,0)
  6290    S DIR(0)= "Y"
  6291   "RTN","RCD PEFTL",199 ,0)
  6292    S DIR("A" )="List th e report i n Microsof t Excel fo rmat"
  6293   "RTN","RCD PEFTL",200 ,0)
  6294    S DIR("B" )="NO"
  6295   "RTN","RCD PEFTL",201 ,0)
  6296    S DIR("?" )="Enter ' YES' to ou tput in Ex cel format . Otherwis e enter 'N O'"
  6297   "RTN","RCD PEFTL",202 ,0)
  6298    D ^DIR
  6299   "RTN","RCD PEFTL",203 ,0)
  6300    I $D(DTOU T)!$D(DUOU T) Q -1
  6301   "RTN","RCD PEFTL",204 ,0)
  6302    Q Y
  6303   "RTN","RCD PEFTL",205 ,0)
  6304    ;
  6305   "RTN","RCD PEFTL",206 ,0)
  6306   GETFRST(LI MIT,END) ;  scan for  first EFT
  6307   "RTN","RCD PEFTL",207 ,0)
  6308    ; Input:
  6309   "RTN","RCD PEFTL",208 ,0)
  6310    ; LIMIT -  Maximum d ays before  aged UNPO STED EFT l ock the ER A worklist
  6311   "RTN","RCD PEFTL",209 ,0)
  6312    ; END - T oday's dat e less LIM IT
  6313   "RTN","RCD PEFTL",210 ,0)
  6314    ; Output
  6315   "RTN","RCD PEFTL",211 ,0)
  6316    ; RET - D ate of fir st 'lock'  EFT or zer o if none  found
  6317   "RTN","RCD PEFTL",212 ,0)
  6318    ;
  6319   "RTN","RCD PEFTL",213 ,0)
  6320    N AGED,EF TDA,RECVDT ,RET
  6321   "RTN","RCD PEFTL",214 ,0)
  6322    ;
  6323   "RTN","RCD PEFTL",215 ,0)
  6324    S RET=0,R ECVDT=$$CU TOFF^RCDPE WLP ; PRCA *4.5*298 i nstall dat e less 60  days
  6325   "RTN","RCD PEFTL",216 ,0)
  6326    ; Scan EF T received  date inde x for days
  6327   "RTN","RCD PEFTL",217 ,0)
  6328    F  S RECV DT=$O(^RCY (344.31,"A DR",RECVDT )) Q:'RECV DT  Q:RECV DT>END  Q: RET  D
  6329   "RTN","RCD PEFTL",218 ,0)
  6330    . S EFTDA =""
  6331   "RTN","RCD PEFTL",219 ,0)
  6332    . ; Scan  individual  EFTs
  6333   "RTN","RCD PEFTL",220 ,0)
  6334    . F  S EF TDA=$O(^RC Y(344.31," ADR",RECVD T,EFTDA))  Q:'EFTDA   D
  6335   "RTN","RCD PEFTL",221 ,0)
  6336    ..  ; Che ck this is  a valid E FT type
  6337   "RTN","RCD PEFTL",222 ,0)
  6338    ..  Q:'$$ VALID(EFTD A)
  6339   "RTN","RCD PEFTL",223 ,0)
  6340    ..  ; Cal culate age d number o f days of  the EFT
  6341   "RTN","RCD PEFTL",224 ,0)
  6342    ..  S AGE D=$$FMDIFF ^XLFDT(DT, RECVDT)
  6343   "RTN","RCD PEFTL",225 ,0)
  6344    ..  ; Unp osted EFT  found olde r than age d days all owed
  6345   "RTN","RCD PEFTL",226 ,0)
  6346    ..  I AGE D>LIMIT S  RET=RECVDT
  6347   "RTN","RCD PEFTL",227 ,0)
  6348    ;
  6349   "RTN","RCD PEFTL",228 ,0)
  6350    Q RET
  6351   "RTN","RCD PEFTL",229 ,0)
  6352    ;
  6353   "RTN","RCD PEFTL",230 ,0)
  6354   VALID(EFTD A) ; Check  if EFT is  a valid c andidate
  6355   "RTN","RCD PEFTL",231 ,0)
  6356    ; Ignore  zero payme nt amts
  6357   "RTN","RCD PEFTL",232 ,0)
  6358    Q:+$$GET1 ^DIQ(344.3 1,EFTDA,.0 7)=0 0
  6359   "RTN","RCD PEFTL",233 ,0)
  6360    ; Ignore  duplicate  EFTs which  have been  removed
  6361   "RTN","RCD PEFTL",234 ,0)
  6362    Q:$$GET1^ DIQ(344.31 ,EFTDA,.18 )]"" 0
  6363   "RTN","RCD PEFTL",235 ,0)
  6364    ; ERA REC ORD (344.3 1, .1) poi nter to ER A record
  6365   "RTN","RCD PEFTL",236 ,0)
  6366    S RCEFT(" ERARecord" )=$$GET1^D IQ(344.31, EFTDA,.1)
  6367   "RTN","RCD PEFTL",237 ,0)
  6368    ; DETAIL  POST STATU S (344.4,  .14); igno re posted  ERA-EFTs
  6369   "RTN","RCD PEFTL",238 ,0)
  6370    I RCEFT(" ERARecord" ),$$GET1^D IQ(344.4,R CEFT("ERAR ecord"),.1 4,"I")=1 Q  0
  6371   "RTN","RCD PEFTL",239 ,0)
  6372    ; Ignore  EFT matche d to Pharm acy ERA
  6373   "RTN","RCD PEFTL",240 ,0)
  6374    I RCEFT(" ERARecord" ),$$PHARM^ RCDPEWLP(R CEFT("ERAR ecord")) Q  0
  6375   "RTN","RCD PEFTL",241 ,0)
  6376    ; Exclude  EFT match ed to Pape r EOB if r eceipt is  processed
  6377   "RTN","RCD PEFTL",242 ,0)
  6378    I 'RCEFT( "ERARecord "),($$GET1 ^DIQ(344.3 1,EFTDA,.0 8,"I")=2)  Q:$$PROC^R CDPEWLP(EF TDA) 0
  6379   "RTN","RCD PEFTL",243 ,0)
  6380    ; Otherwi se valid
  6381   "RTN","RCD PEFTL",244 ,0)
  6382    Q 1
  6383   "RTN","RCD PEFTL",245 ,0)
  6384    ;
  6385   "RTN","RCD PEFTL",246 ,0)
  6386   PAD(A,N) ;  pad A wit h spaces t o length N
  6387   "RTN","RCD PEFTL",247 ,0)
  6388    Q A_$J("  ",N-$L(A))   ; always  add at le ast one tr ailing spa ce
  6389   "RTN","RCD PEFTL",248 ,0)
  6390    ;
  6391   "RTN","RCD PEM2")
  6392   0^16^B1465 85710
  6393   "RTN","RCD PEM2",1,0)
  6394   RCDPEM2 ;A LB/TMK/PJH  - MANUAL  ERA AND EF T MATCHING  ;Jun 11,  2014@13:24 :36
  6395   "RTN","RCD PEM2",2,0)
  6396    ;;4.5;Acc ounts Rece ivable;**1 73,208,276 ,284,293,2 98,303,304 ,321,326,3 32**;Mar 2 0, 1995;Bu ild 34
  6397   "RTN","RCD PEM2",3,0)
  6398    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  6399   "RTN","RCD PEM2",4,0)
  6400    Q
  6401   "RTN","RCD PEM2",5,0)
  6402    ;
  6403   "RTN","RCD PEM2",6,0)
  6404    ; PRCA*4. 5*303 - Ma nually Mat ch EFT fro m Worklist  screen
  6405   "RTN","RCD PEM2",7,0)
  6406    ;
  6407   "RTN","RCD PEM2",8,0)
  6408   MATCHWL ;  Manually ' match' ERA  to an EFT  that orig inates fro m [RCDPE W ORKLIST ER A LIST]
  6409   "RTN","RCD PEM2",9,0)
  6410    N DA,DIC, DIE,DIR,DR ,DTRNG,DTO UT,DUOUT,E FTTOT,END, ERATOT,RCE FT,RCERA,R CMBG,RCMAT CH,RCNAME, RCQUIT,STA RT,X,Y
  6411   "RTN","RCD PEM2",10,0 )
  6412    D FULL^VA LM1
  6413   "RTN","RCD PEM2",11,0 )
  6414    ; PRCA*4. 5*332 - Be gin modifi ed code bl ock
  6415   "RTN","RCD PEM2",12,0 )
  6416    S RCMBG=V ALMBG
  6417   "RTN","RCD PEM2",13,0 )
  6418    S RCERA=$ $SEL^RCDPE WL7()                     ; Sele ct ERA to  use from s creen
  6419   "RTN","RCD PEM2",14,0 )
  6420    I RCERA=0  D MWQ Q
  6421   "RTN","RCD PEM2",15,0 )
  6422    ;
  6423   "RTN","RCD PEM2",16,0 )
  6424    ; Save th e line, we  need it w hen we go  back to th e worklist .
  6425   "RTN","RCD PEM2",17,0 )
  6426    S RCERA(0 )=^RCY(344 .4,RCERA,0 )              ; Get  the zero n ode for th is ERA 
  6427   "RTN","RCD PEM2",18,0 )
  6428    I ((+($P( RCERA(0),U ,9)))>0)!( $P(RCERA(0 ),U,8)'="" ) D  Q  ;  PRCA*4.5*3 26
  6429   "RTN","RCD PEM2",19,0 )
  6430    . W !,"ER A is alrea dy matched  please se lect anoth er ERA..."
  6431   "RTN","RCD PEM2",20,0 )
  6432    . D WAIT^ VALM1
  6433   "RTN","RCD PEM2",21,0 )
  6434    . D MWQ
  6435   "RTN","RCD PEM2",22,0 )
  6436    D EN^RCDP EE(RCERA)                   ; Se lect EFT b y partial  matches?
  6437   "RTN","RCD PEM2",23,0 )
  6438    D MWQ
  6439   "RTN","RCD PEM2",24,0 )
  6440    Q
  6441   "RTN","RCD PEM2",25,0 )
  6442    ; PRCA*4. 5*332 - En d modified  code bloc k
  6443   "RTN","RCD PEM2",26,0 )
  6444    ;
  6445   "RTN","RCD PEM2",27,0 )
  6446   GETDINFO(R CEFT,DEPNU M,DEPDT)     ;EP from  RCDPEE
  6447   "RTN","RCD PEM2",28,0 )
  6448    ; Get the  Deposit D ate and De posit Numb er for the  specified  EFT
  6449   "RTN","RCD PEM2",29,0 )
  6450    ; Input:    RCEFT        - IEN  for file # 344.31
  6451   "RTN","RCD PEM2",30,0 )
  6452    ; Output:   DEPNUM       - Depo sit Number  (#344.3,  .06)
  6453   "RTN","RCD PEM2",31,0 )
  6454    ;           DEPDT        - Depo sit Date ( #344.3, .0 7)
  6455   "RTN","RCD PEM2",32,0 )
  6456    N IEN3443
  6457   "RTN","RCD PEM2",33,0 )
  6458    S IEN3443 =$$GET1^DI Q(344.31,R CEFT_",",. 01,"I")      ; IEN fo r file 344 .3
  6459   "RTN","RCD PEM2",34,0 )
  6460    S DEPNUM= $$GET1^DIQ (344.3,IEN 3443_",",. 06,"E")      ; Deposi t Number
  6461   "RTN","RCD PEM2",35,0 )
  6462    S DEPDT=$ $GET1^DIQ( 344.3,IEN3 443_",",.0 7,"E")       ; Deposi t Number
  6463   "RTN","RCD PEM2",36,0 )
  6464    Q
  6465   "RTN","RCD PEM2",37,0 )
  6466    ;
  6467   "RTN","RCD PEM2",38,0 )
  6468    ; Quit ba ck to the  worklist V ALMBCK wil l be kille d by List  Manager.
  6469   "RTN","RCD PEM2",39,0 )
  6470    ; Rebuild  the scree n because  we may hav e changed  it.
  6471   "RTN","RCD PEM2",40,0 )
  6472   MWQ D INIT ^RCDPEWL7
  6473   "RTN","RCD PEM2",41,0 )
  6474    S VALMBCK ="R",VALMB G=RCMBG
  6475   "RTN","RCD PEM2",42,0 )
  6476    Q
  6477   "RTN","RCD PEM2",43,0 )
  6478    ;
  6479   "RTN","RCD PEM2",44,0 )
  6480   MATCH1 ; M anually 'm atch' an E RA to an E FT
  6481   "RTN","RCD PEM2",45,0 )
  6482    N DA,DIC, DIE,DIR,DI ROUT,DR,DT RNG,DTOUT, DUOUT,EFTT OT,END,ERA TOT
  6483   "RTN","RCD PEM2",46,0 )
  6484    N RCEFT,R CERA,RCMAT CH,RCMTFLG ,RCNAME,RC QUIT,START ,X,XX,Y,YY
  6485   "RTN","RCD PEM2",47,0 )
  6486    W !,"THIS  OPTION WI LL ALLOW Y OU TO MANU ALLY MATCH  AN EFT DE TAIL RECOR D"
  6487   "RTN","RCD PEM2",48,0 )
  6488    W !,"WITH  AN ERA RE CORD."
  6489   "RTN","RCD PEM2",49,0 )
  6490    ;S XX=$$P MATCH(RCER A)
  6491   "RTN","RCD PEM2",50,0 )
  6492    ; PRCA*4. 5*298 - Ad d ability  to specify  a date ra nge
  6493   "RTN","RCD PEM2",51,0 )
  6494    S DIR("A" )="Select  by date Ra nge? (Y/N)  ",DIR(0)= "YA",DIR(" B")="NO"
  6495   "RTN","RCD PEM2",52,0 )
  6496    D ^DIR K  DIR
  6497   "RTN","RCD PEM2",53,0 )
  6498    I $D(DUOU T)!$D(DTOU T) G M1Q
  6499   "RTN","RCD PEM2",54,0 )
  6500    I Y<1 G M 1
  6501   "RTN","RCD PEM2",55,0 )
  6502    S DTRNG=Y   ; flag i ndicating  date range  selected
  6503   "RTN","RCD PEM2",56,0 )
  6504    K DIR
  6505   "RTN","RCD PEM2",57,0 )
  6506    S DIR("?" )="Enter t he earlies t date for  the selec tion range ."
  6507   "RTN","RCD PEM2",58,0 )
  6508    ; value i n DIR(0) f or %DT = A PE: ask da te, past a ssumed, ec ho answer
  6509   "RTN","RCD PEM2",59,0 )
  6510    S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="St art Date:  "
  6511   "RTN","RCD PEM2",60,0 )
  6512    D ^DIR K  DIR
  6513   "RTN","RCD PEM2",61,0 )
  6514    I $D(DTOU T)!$D(DUOU T)!(Y="")  G M1Q
  6515   "RTN","RCD PEM2",62,0 )
  6516    S START=Y
  6517   "RTN","RCD PEM2",63,0 )
  6518    K DIR,X,Y
  6519   "RTN","RCD PEM2",64,0 )
  6520    S DIR("?" )="Enter t he latest  date for t he selecti on range."
  6521   "RTN","RCD PEM2",65,0 )
  6522    S DIR(0)= "DAO^"_STA RT_":"_DT_ ":APE",DIR ("A")="End  Date: ",D IR("B")=$$ FMTE^XLFDT (DT)
  6523   "RTN","RCD PEM2",66,0 )
  6524    D ^DIR K  DIR
  6525   "RTN","RCD PEM2",67,0 )
  6526    I $D(DTOU T)!$D(DUOU T)!(Y="")  G M1Q
  6527   "RTN","RCD PEM2",68,0 )
  6528    S END=Y
  6529   "RTN","RCD PEM2",69,0 )
  6530    ;
  6531   "RTN","RCD PEM2",70,0 )
  6532    ; Replace  DIR with  DIC call f or EFT lin e identifi er - PRCA* 4.5*326
  6533   "RTN","RCD PEM2",71,0 )
  6534   M1 S DIC(" A")="SELEC T THE UNMA TCHED EFT  TO MATCH T O AN ERA:  "
  6535   "RTN","RCD PEM2",72,0 )
  6536    ;
  6537   "RTN","RCD PEM2",73,0 )
  6538    ; start P RCA*4.5*29 3 Add extr a checks t o filter o ut EFTs th at have 
  6539   "RTN","RCD PEM2",74,0 )
  6540    ; a payme nt amount  of zero or  EFTs that  have been  removed.
  6541   "RTN","RCD PEM2",75,0 )
  6542    ; Only UN MATCHED EF Ts with pa yment amt  >0 and not  removed s hould
  6543   "RTN","RCD PEM2",76,0 )
  6544    ; be sele ctable by  the user.
  6545   "RTN","RCD PEM2",77,0 )
  6546    ;
  6547   "RTN","RCD PEM2",78,0 )
  6548    N DEPDT,D EPNUM
  6549   "RTN","RCD PEM2",79,0 )
  6550    S DIC("W" )="D DICW^ RCDPEM3"
  6551   "RTN","RCD PEM2",80,0 )
  6552    S DIC(0)= "AEMQ"
  6553   "RTN","RCD PEM2",81,0 )
  6554    S DIC=344 .31
  6555   "RTN","RCD PEM2",82,0 )
  6556    S DIC("S" )="I ('$P( ^(0),U,8)) &($P($G(^( 0)),U,7))& ('$P($G(^( 3)),U))"
  6557   "RTN","RCD PEM2",83,0 )
  6558    S:$G(DTRN G) DIC("S" )=DIC("S") _"&'($P($G (^(0)),U,1 3)<START)& '($P($G(^( 0)),U,13)> END)"
  6559   "RTN","RCD PEM2",84,0 )
  6560    ; end PRC A*4.5*293
  6561   "RTN","RCD PEM2",85,0 )
  6562    ;
  6563   "RTN","RCD PEM2",86,0 )
  6564    W !
  6565   "RTN","RCD PEM2",87,0 )
  6566    D ^DIC K  DIC
  6567   "RTN","RCD PEM2",88,0 )
  6568    I $D(DUOU T)!$D(DTOU T)!(Y<0) G  M1Q
  6569   "RTN","RCD PEM2",89,0 )
  6570    S RCEFT=+ Y
  6571   "RTN","RCD PEM2",90,0 )
  6572    D GETDINF O(RCEFT,.D EPNUM,.DEP DT)
  6573   "RTN","RCD PEM2",91,0 )
  6574    W !
  6575   "RTN","RCD PEM2",92,0 )
  6576    S DIC="^R CY(344.31, ",DR="0",D A=RCEFT D  EN^DIQ
  6577   "RTN","RCD PEM2",93,0 )
  6578    W "  DEPO SIT NUMBER : ",DEPNUM ,?40,"DEPO SIT DATE:  ",DEPDT
  6579   "RTN","RCD PEM2",94,0 )
  6580    W !
  6581   "RTN","RCD PEM2",95,0 )
  6582    S DIR("A" )="ARE YOU  SURE THIS  IS THE EF T YOU WANT  TO MATCH? : "
  6583   "RTN","RCD PEM2",96,0 )
  6584    S DIR(0)= "YA",DIR(" B")="YES"
  6585   "RTN","RCD PEM2",97,0 )
  6586    D ^DIR K  DIR
  6587   "RTN","RCD PEM2",98,0 )
  6588    I $D(DUOU T)!$D(DTOU T) G M1Q
  6589   "RTN","RCD PEM2",99,0 )
  6590    I Y'=1 G  M1
  6591   "RTN","RCD PEM2",100, 0)
  6592    ; Add EFT  line iden tifier - P RCA*4.5*32 6
  6593   "RTN","RCD PEM2",101, 0)
  6594   M12 S DIR( "A")="SELE CT THE UNM ATCHED ERA  TO MATCH  TO EFT #"  ; PRCA*4.5 *326
  6595   "RTN","RCD PEM2",102, 0)
  6596    S DIR("A" )=DIR("A") _$$GET1^DI Q(344.31,R CEFT,.01," E")_": " ;  PRCA*4.5* 326
  6597   "RTN","RCD PEM2",103, 0)
  6598    S DIR(0)= "PAO^RCY(3 44.4,:AEMQ ",DIR("S") ="I '$P(^( 0),U,9),'$ P(^(0),U,8 )"
  6599   "RTN","RCD PEM2",104, 0)
  6600    W ! D ^DI R K DIR
  6601   "RTN","RCD PEM2",105, 0)
  6602    I $D(DUOU T)!$D(DTOU T)!(Y<0) G  M1Q
  6603   "RTN","RCD PEM2",106, 0)
  6604    S RCERA=+ Y
  6605   "RTN","RCD PEM2",107, 0)
  6606    W !
  6607   "RTN","RCD PEM2",108, 0)
  6608    S DIC="^R CY(344.4," ,DR="0",DA =RCERA D E N^DIQ
  6609   "RTN","RCD PEM2",109, 0)
  6610    W !
  6611   "RTN","RCD PEM2",110, 0)
  6612    S DIR("A" )="ARE YOU  SURE THIS  IS THE CO RRECT ERA  TO MATCH T O?: ",DIR( 0)="YA",DI R("B")="YE S" D ^DIR  K DIR
  6613   "RTN","RCD PEM2",111, 0)
  6614    I $D(DUOU T)!$D(DTOU T) G M1Q
  6615   "RTN","RCD PEM2",112, 0)
  6616    I Y'=1 G  M12
  6617   "RTN","RCD PEM2",113, 0)
  6618    ;
  6619   "RTN","RCD PEM2",114, 0)
  6620   M12A ; PRC A*4.5*303  - MATCH WL  jumps her e to compl ete the ma nual match
  6621   "RTN","RCD PEM2",115, 0)
  6622    ; BEGIN P RCA*4.5*32 6
  6623   "RTN","RCD PEM2",116, 0)
  6624    S ERATOT= $$GET1^DIQ (344.4,RCE RA,.05,"I" ) ; ERA Pa id Amount
  6625   "RTN","RCD PEM2",117, 0)
  6626    S EFTTOT= $$GET1^DIQ (344.31,RC EFT,.07,"I ") ; EFT A mount of P ayment
  6627   "RTN","RCD PEM2",118, 0)
  6628    S RCMATCH =(+ERATOT= +EFTTOT) ;  Do the To tals Match
  6629   "RTN","RCD PEM2",119, 0)
  6630    ;
  6631   "RTN","RCD PEM2",120, 0)
  6632    ; If the  totals don 't match,  manual mat ch is not  allowed
  6633   "RTN","RCD PEM2",121, 0)
  6634    ;I 'RCMAT CH D  G M1 Q
  6635   "RTN","RCD PEM2",122, 0)
  6636    ;. W !,*7 ,$J("",3)_ "> The amo unt of pay ment on th ese two re cords do n ot agree."
  6637   "RTN","RCD PEM2",123, 0)
  6638    ;. K DIR  S DIR(0)=" EA",DIR("A ")="Press  ENTER to c ontinue: "
  6639   "RTN","RCD PEM2",124, 0)
  6640    ;. D ^DIR
  6641   "RTN","RCD PEM2",125, 0)
  6642    ;. S RCQU IT=1
  6643   "RTN","RCD PEM2",126, 0)
  6644    ;
  6645   "RTN","RCD PEM2",127, 0)
  6646    S XX=$$GE T1^DIQ(344 .4,RCERA,. 06,"I") ;  ERA Payer  Name
  6647   "RTN","RCD PEM2",128, 0)
  6648    S YY=$$GE T1^DIQ(344 .31,RCEFT, .02,"I") ;  EFT Payer  Name
  6649   "RTN","RCD PEM2",129, 0)
  6650    S RCNAME= (XX=YY) ;  Do the Pay er Names M atch
  6651   "RTN","RCD PEM2",130, 0)
  6652    I 'RCNAME  D  G:RCQU IT M1Q
  6653   "RTN","RCD PEM2",131, 0)
  6654    . N Z
  6655   "RTN","RCD PEM2",132, 0)
  6656    . S RCQUI T=0,Z=1
  6657   "RTN","RCD PEM2",133, 0)
  6658    . S DIR(" A",1)="*** WARNING*** "
  6659   "RTN","RCD PEM2",134, 0)
  6660    . I 'RCNA ME S Z=Z+1 ,DIR("A",Z )=$J("",3) _"> The pa yer names  on these t wo records  do not ag ree"
  6661   "RTN","RCD PEM2",135, 0)
  6662    . S DIR(0 )="YA",DIR ("B")="NO" ,DIR("A")= "ARE YOU S URE YOU WA NT TO MATC H THESE 2  RECORDS?:  "
  6663   "RTN","RCD PEM2",136, 0)
  6664    . W ! D ^ DIR K DIR
  6665   "RTN","RCD PEM2",137, 0)
  6666    . I $S($D (DUOUT)!$D (DTOUT):1, Y'=1:1,1:0 ) S RCQUIT =1 Q
  6667   "RTN","RCD PEM2",138, 0)
  6668    ; END PRC A*4.5*326
  6669   "RTN","RCD PEM2",139, 0)
  6670    S DIE="^R CY(344.4," ,DR=".09// //1",DA=RC ERA D ^DIE
  6671   "RTN","RCD PEM2",140, 0)
  6672    I '$D(Y)  S DIE="^RC Y(344.31," ,DR=".08// //1;.1//// "_RCERA,DA =RCEFT D ^ DIE
  6673   "RTN","RCD PEM2",141, 0)
  6674    S RCMTFLG =$S('$D(Y) :1,1:0)
  6675   "RTN","RCD PEM2",142, 0)
  6676    ; PRCA*4. 5*326 - Ad d EFT suff ix
  6677   "RTN","RCD PEM2",143, 0)
  6678    W !,"EFT  #"_$$GET1^ DIQ(344.31 ,RCEFT,.01 ,"E")_" WA S "_$S(RCM TFLG:"SUCC ESSFULLY", 1:"NOT")_"  MATCHED T O ERA #"_R CERA ; PRC A*4.5*326
  6679   "RTN","RCD PEM2",144, 0)
  6680    I 'RCMTFL G S DIR(0) ="E" D ^DI R K DIR G  M1Q
  6681   "RTN","RCD PEM2",145, 0)
  6682    ;PRCA*4.5 *304 add a bility to  use auto-p osting for  a manuall y matched  item
  6683   "RTN","RCD PEM2",146, 0)
  6684    ;  Only i f the amou nt of paym ents match .
  6685   "RTN","RCD PEM2",147, 0)
  6686    I 'RCMATC H D  G M1Q     ;if pa yment amou nts don't  match, don 't allow f or auto-po sting.
  6687   "RTN","RCD PEM2",148, 0)
  6688    . W !,"ER A/EFT bala nces do no t match -  cannot Mar k for Auto -Post. Pre ss any key ." S DIR(0 )="E" D ^D IR K DIR
  6689   "RTN","RCD PEM2",149, 0)
  6690    W !
  6691   "RTN","RCD PEM2",150, 0)
  6692    K DIR
  6693   "RTN","RCD PEM2",151, 0)
  6694    S DIR("A" )="Do you  wish to ma rk this en try for Au to Posting  (Y/N)? "
  6695   "RTN","RCD PEM2",152, 0)
  6696    S DIR(0)= "YA"
  6697   "RTN","RCD PEM2",153, 0)
  6698    D ^DIR
  6699   "RTN","RCD PEM2",154, 0)
  6700    I 'Y K DI R S DIR(0) ="E" D ^DI R G M1Q
  6701   "RTN","RCD PEM2",155, 0)
  6702    N AUTOPOS T
  6703   "RTN","RCD PEM2",156, 0)
  6704    S AUTOPOS T=$$AUTOCH K2^RCDPEAP 1(RCERA,1)  ; Allow a uto-post f or CHK and  ACH type  ERA - PRCA *4.5*321
  6705   "RTN","RCD PEM2",157, 0)
  6706    I AUTOPOS T D
  6707   "RTN","RCD PEM2",158, 0)
  6708    . D SETST A^RCDPEAP( RCERA,0,"M anual Matc h: Marked  as Auto-Po st Candida te")
  6709   "RTN","RCD PEM2",159, 0)
  6710    . W !,"ER A has been  successfu lly Marked  as an Aut o-Post CAN DIDATE"
  6711   "RTN","RCD PEM2",160, 0)
  6712    I 'AUTOPO ST D
  6713   "RTN","RCD PEM2",161, 0)
  6714    . D AUDIT LOG^RCDPEA P(RCERA,"" ,"Manual M atch: Not  Marked as  Auto-Post  Candidate- "_$P(AUTOP OST,U,2))
  6715   "RTN","RCD PEM2",162, 0)
  6716    . W !,"ER A was NOT  Marked as  an Auto-Po st CANDIDA TE - ",$P( AUTOPOST,U ,2)
  6717   "RTN","RCD PEM2",163, 0)
  6718    K DIR S D IR(0)="E"  D ^DIR
  6719   "RTN","RCD PEM2",164, 0)
  6720   M1Q Q
  6721   "RTN","RCD PEM2",165, 0)
  6722    ;
  6723   "RTN","RCD PEM2",166, 0)
  6724   MATCH2 ; M anually 'm atch' a 0- balance EF T to a pap er EOB
  6725   "RTN","RCD PEM2",167, 0)
  6726    N DUOUT,D TOUT,DA,DR ,DIE,DIC,D IR,X,Y,RCE FT,RCRCPT
  6727   "RTN","RCD PEM2",168, 0)
  6728    W !,"THIS  OPTION WI LL ALLOW Y OU TO MANU ALLY MARK  A 0-BALANC E EFT DETA IL RECORD" ,!,"AS MAT CHED TO A  PAPER EOB"
  6729   "RTN","RCD PEM2",169, 0)
  6730    ; BEGIN P RCA*4.5*32 6
  6731   "RTN","RCD PEM2",170, 0)
  6732   M2 S DIC(" A")="SELEC T THE UNMA TCHED 0-BA LANCE EFT  TO MARK AS  MATCHED T O PAPER EO B: "
  6733   "RTN","RCD PEM2",171, 0)
  6734    S DIC("W" )="D DICW^ RCDPEM3"
  6735   "RTN","RCD PEM2",172, 0)
  6736    S DIC(0)= "AEMQ"
  6737   "RTN","RCD PEM2",173, 0)
  6738    S DIC("S" )="I '$P(^ (0),U,8),' $P(^(0),U, 7)"
  6739   "RTN","RCD PEM2",174, 0)
  6740    S DIC=344 .31
  6741   "RTN","RCD PEM2",175, 0)
  6742    D ^DIC
  6743   "RTN","RCD PEM2",176, 0)
  6744    ; END PRC A*4.5*326
  6745   "RTN","RCD PEM2",177, 0)
  6746    I $D(DUOU T)!$D(DTOU T)!(Y'>0)  G M2Q
  6747   "RTN","RCD PEM2",178, 0)
  6748    S RCEFT=+ Y
  6749   "RTN","RCD PEM2",179, 0)
  6750    W !
  6751   "RTN","RCD PEM2",180, 0)
  6752    S DIC="^R CY(344.31, ",DR="0",D A=RCEFT D  EN^DIQ
  6753   "RTN","RCD PEM2",181, 0)
  6754    W !
  6755   "RTN","RCD PEM2",182, 0)
  6756    S DIR("A" )="ARE YOU  SURE THIS  IS THE EF T YOU WANT  TO MARK A S MATCHED? : ",DIR(0) ="YA",DIR( "B")="YES"  D ^DIR K  DIR
  6757   "RTN","RCD PEM2",183, 0)
  6758    I $D(DUOU T)!$D(DTOU T) G M2Q
  6759   "RTN","RCD PEM2",184, 0)
  6760    I Y'=1 G  M2
  6761   "RTN","RCD PEM2",185, 0)
  6762    S DIE="^R CY(344.31, ",DR=".08/ ///2",DA=R CEFT D ^DI E
  6763   "RTN","RCD PEM2",186, 0)
  6764    S DIR(0)= "EA",DIR(" A")="EFT # "_RCEFT_"  WAS "_$S(' $D(Y):"SUC CESSFULLY" ,1:"NOT")_ " MARKED A S MATCHED  TO PAPER E OB" D ^DIR  K DIR
  6765   "RTN","RCD PEM2",187, 0)
  6766   M2Q Q
  6767   "RTN","RCD PEM2",188, 0)
  6768    ;
  6769   "RTN","RCD PEM2",189, 0)
  6770   MANTR ; Ma rk an EFT  detail rec ord as 'TR ' posted m anually
  6771   "RTN","RCD PEM2",190, 0)
  6772    N DA,DR,D IC,DIE,DIR ,X,Y,RCEFT ,DUOUT,DTO UT,RCZ0,RC TR,RCHOW
  6773   "RTN","RCD PEM2",191, 0)
  6774    ; EFT det ail cannot  be associ ated with  a receipt  or TR docu ment
  6775   "RTN","RCD PEM2",192, 0)
  6776    ;
  6777   "RTN","RCD PEM2",193, 0)
  6778    W !,"**** *",!," YOU  SHOULD ON LY USE THI S OPTION I F YOU HAVE  AN EFT DE TAIL RECOR D ON YOUR" ,!," UNAPP LIED DEPOS IT REPORT  WHOSE DETA IL WAS ENT ERED ON LI NE VIA A T R DOCUMENT ",!,"***** ",!
  6779   "RTN","RCD PEM2",194, 0)
  6780    S DIC(0)= "AEMQ",DIC ("S")="I $ P(^(0),U,1 6)="""",$P (^(0),U,11 )",DIC("A" )="SELECT  THE EFT DE TAIL WHOSE  'TR' DOC  WAS MANUAL LY ENTERED  ON LINE:  ",DIC="^RC Y(344.31,"
  6781   "RTN","RCD PEM2",195, 0)
  6782    W ! D ^DI C K DIC
  6783   "RTN","RCD PEM2",196, 0)
  6784    I Y'>0 G  MANTRQ
  6785   "RTN","RCD PEM2",197, 0)
  6786    S RCEFT=+ Y,RCZ0=$G( ^RCY(344.3 1,RCEFT,0) )
  6787   "RTN","RCD PEM2",198, 0)
  6788    S DIR(0)= "FA^2:30^K :X'?1""TR" ".E X",DIR ("A")="ENT ER THE TR  DOC # THAT  WAS ENTER ED ON-LINE  FOR THE E FT DETAIL:  "
  6789   "RTN","RCD PEM2",199, 0)
  6790    W ! D ^DI R K DIR
  6791   "RTN","RCD PEM2",200, 0)
  6792    I $D(DTOU T)!$D(DUOU T) G MANTR Q
  6793   "RTN","RCD PEM2",201, 0)
  6794    S RCTR=Y, DR=""
  6795   "RTN","RCD PEM2",202, 0)
  6796    ;
  6797   "RTN","RCD PEM2",203, 0)
  6798    I '$P(RCZ 0,U,8) D   G:RCQUIT M ANTRQ  ;Un matched
  6799   "RTN","RCD PEM2",204, 0)
  6800    . S DIR(0 )="SA^E:EL ECTRONIC E RA;P:PAPER  EOB",DIR( "A")="WAS  THE EFT DE TAIL RECEI VED BY (E) RA or (P)A PER EOB?:  " W ! D ^D IR K DIR
  6801   "RTN","RCD PEM2",205, 0)
  6802    . I $D(DT OUT)!$D(DU OUT) S RCQ UIT=1 Q
  6803   "RTN","RCD PEM2",206, 0)
  6804    . S RCHOW =Y,DR=""
  6805   "RTN","RCD PEM2",207, 0)
  6806    . I RCHOW ="E" D
  6807   "RTN","RCD PEM2",208, 0)
  6808    .. S DR=" ;.09R;.08/ ///1"
  6809   "RTN","RCD PEM2",209, 0)
  6810    . I RCHOW ="P" D
  6811   "RTN","RCD PEM2",210, 0)
  6812    .. S DR=" ;.08////2"
  6813   "RTN","RCD PEM2",211, 0)
  6814    ;
  6815   "RTN","RCD PEM2",212, 0)
  6816    S DIR(0)= "YA",DIR(" B")="NO",D IR("A",1)= "THIS WILL  MARK EFT  DETAIL #:  "_RCEFT_"  AS MANUALL Y POSTED", DIR("A",2) ="  USING  TR DOC: "_ RCTR
  6817   "RTN","RCD PEM2",213, 0)
  6818    S DIR("A" )="ARE YOU  SURE YOU  WANT TO CO NTINUE?: "  W ! D ^DI R K DIR
  6819   "RTN","RCD PEM2",214, 0)
  6820    I Y'=1 D   G MANTRQ
  6821   "RTN","RCD PEM2",215, 0)
  6822    . S DIR(0 )="EA",DIR ("A")="EFT  NOT UPDAT ED - Press  ENTER to  continue:  " W ! D ^D IR K DIR
  6823   "RTN","RCD PEM2",216, 0)
  6824    S DIE="^R CY(344.31, ",DA=RCEFT ,DR=".16R" _DR D ^DIE
  6825   "RTN","RCD PEM2",217, 0)
  6826    I $D(Y) D
  6827   "RTN","RCD PEM2",218, 0)
  6828    . S DIE=" ^RCY(344.3 1,",DA=RCE FT,DR=".16 ///@;.08// /"_$S($P(R CZ0,U,8)'= "":$P(RCZ0 ,U,8),1:"@ ") D ^DIE
  6829   "RTN","RCD PEM2",219, 0)
  6830    . S DIR(" A")="EFT N OT UPDATED  - Press E NTER to co ntinue: "
  6831   "RTN","RCD PEM2",220, 0)
  6832    E  D
  6833   "RTN","RCD PEM2",221, 0)
  6834    . S DIR(" A")="STATU S UPDATED  FOR EFT DE TAIL #: "_ RCEFT_" -  Press ENTE R to conti nue: "
  6835   "RTN","RCD PEM2",222, 0)
  6836    S DIR(0)= "EA"
  6837   "RTN","RCD PEM2",223, 0)
  6838    W ! D ^DI R K DIR
  6839   "RTN","RCD PEM2",224, 0)
  6840    ;
  6841   "RTN","RCD PEM2",225, 0)
  6842   MANTRQ Q
  6843   "RTN","RCD PEM2",226, 0)
  6844    ;
  6845   "RTN","RCD PEM2",227, 0)
  6846   CHK() ; Fu nction ret urns the i en of CHEC K/MO payme nt type
  6847   "RTN","RCD PEM2",228, 0)
  6848    Q +$O(^RC (341.1,"AC ",4,0))
  6849   "RTN","RCD PEM2",229, 0)
  6850    ;
  6851   "RTN","RCD PEM2",230, 0)
  6852    ;
  6853   "RTN","RCD PEM2",231, 0)
  6854    ;
  6855   "RTN","RCD PEM2",232, 0)
  6856   MATCH3 ; M anually 'm atch' a 0- balance ER A that has  no check  or EFT
  6857   "RTN","RCD PEM2",233, 0)
  6858    N DUOUT,D TOUT,DA,DR ,DIE,DIC,D IR,X,Y,RCE RA,RCRCPT
  6859   "RTN","RCD PEM2",234, 0)
  6860    W !,"THIS  OPTION WI LL ALLOW Y OU TO MANU ALLY MARK  A 0-BALANC E ERA WITH  NO",!,"CH ECK OR EFT  AS 'MATCH -0 PAYMENT ' TO REMOV E IT FROM  THE ERA AG ING REPORT "
  6861   "RTN","RCD PEM2",235, 0)
  6862   M3 S DIR(" A")="SELEC T THE UNMA TCHED 0-BA LANCE ERA  TO MARK AS  MATCHED:  "
  6863   "RTN","RCD PEM2",236, 0)
  6864    S DIR(0)= "PAO^RCY(3 44.4,:AEMQ ",DIR("S") ="I '$P(^( 0),U,9),'$ P(^(0),U,5 )"
  6865   "RTN","RCD PEM2",237, 0)
  6866    W ! D ^DI R K DIR
  6867   "RTN","RCD PEM2",238, 0)
  6868    I $D(DUOU T)!$D(DTOU T)!(Y'>0)  G M3Q
  6869   "RTN","RCD PEM2",239, 0)
  6870    S RCERA=+ Y
  6871   "RTN","RCD PEM2",240, 0)
  6872    W !
  6873   "RTN","RCD PEM2",241, 0)
  6874    S DIC="^R CY(344.4," ,DR="0",DA =RCERA D E N^DIQ
  6875   "RTN","RCD PEM2",242, 0)
  6876    W !
  6877   "RTN","RCD PEM2",243, 0)
  6878    S DIR("A" )="ARE YOU  SURE THIS  IS THE ER A YOU WANT  TO MARK A S MATCH-0  PAYMENT? ( Y/N) ",DIR (0)="YA",D IR("B")="Y ES" D ^DIR  K DIR
  6879   "RTN","RCD PEM2",244, 0)
  6880    I $D(DUOU T)!$D(DTOU T) G M3Q
  6881   "RTN","RCD PEM2",245, 0)
  6882    I Y'=1 G  M3
  6883   "RTN","RCD PEM2",246, 0)
  6884    S DIE="^R CY(344.4," ,DR=".09// //3",DA=RC ERA D ^DIE
  6885   "RTN","RCD PEM2",247, 0)
  6886    S DIR(0)= "EA",DIR(" A")="ERA # "_RCERA_"  WAS "_$S(' $D(Y):"SUC CESSFULLY" ,1:"NOT")_ " MARKED A S MATCH-0  PAYMENT" D  ^DIR K DI R
  6887   "RTN","RCD PEM2",248, 0)
  6888   M3Q Q
  6889   "RTN","RCD PEM2",249, 0)
  6890    ;
  6891   "RTN","RCD PEM2",250, 0)
  6892   UNMATCH ;  Used to 'u nmatch' an  ERA match ed in erro r
  6893   "RTN","RCD PEM2",251, 0)
  6894    N AUTOPOS T,DA,DIC,D IE,DIK,DIR ,DIROUT,DR ,DTOUT,DUO UTX,RCEFT, RCQUIT,RCW L,X,XX,Y
  6895   "RTN","RCD PEM2",252, 0)
  6896    S DIC(0)= "AEMQ",DIC ="^RCY(344 .4,"
  6897   "RTN","RCD PEM2",253, 0)
  6898    S DIC("S" )="I '$P(^ (0),U,8),$ S('$P(^(0) ,U,14):1,1 :$P(^(0),U ,9)=3),$P( ^(0),U,9)"
  6899   "RTN","RCD PEM2",254, 0)
  6900    D ^DIC K  DIC
  6901   "RTN","RCD PEM2",255, 0)
  6902    Q:Y'>0
  6903   "RTN","RCD PEM2",256, 0)
  6904    S RCWL=+Y ,RCQUIT=0
  6905   "RTN","RCD PEM2",257, 0)
  6906    I $D(^RCY (344.49,RC WL,0)) D   Q:RCQUIT
  6907   "RTN","RCD PEM2",258, 0)
  6908    . S DIR(0 )="YA"
  6909   "RTN","RCD PEM2",259, 0)
  6910    . S XX="T HIS ERA AL READY HAS  A SCRATCH  PAD ENTRY  AND MUST B E DELETED  BEFORE IT  CAN BE"
  6911   "RTN","RCD PEM2",260, 0)
  6912    . S DIR(" A",1)=XX
  6913   "RTN","RCD PEM2",261, 0)
  6914    . S DIR(" A")="UNMAT CHED. DO Y OU WANT TO  DELETE TH E SCRATCH  PAD ENTRY  FOR THIS E RA NOW? "
  6915   "RTN","RCD PEM2",262, 0)
  6916    . W ! D ^ DIR K DIR
  6917   "RTN","RCD PEM2",263, 0)
  6918    . I Y'=1  S RCQUIT=1  Q
  6919   "RTN","RCD PEM2",264, 0)
  6920    . S DIK=" ^RCY(344.4 9,",DA=RCW L D ^DIK
  6921   "RTN","RCD PEM2",265, 0)
  6922    S AUTOPOS T=""
  6923   "RTN","RCD PEM2",266, 0)
  6924    I $O(^RCY (344.31,"A ERA",RCWL, 0)) S RCEF T=+$O(^(0) ) D  Q:RCQ UIT
  6925   "RTN","RCD PEM2",267, 0)
  6926    . S AUTOP OST=$$GET1 ^DIQ(344.4 ,RCWL_",", 4.02,"I")
  6927   "RTN","RCD PEM2",268, 0)
  6928    . W !!,"T HIS ERA IS  MATCHED T O EFT #"_$ $OUT^RCDPE M3(RCEFT)
  6929   "RTN","RCD PEM2",269, 0)
  6930    . I AUTOP OST=0 W !, "* WARNING : This ERA  will be U n-Marked a s an Auto- Post CANDI DATE"
  6931   "RTN","RCD PEM2",270, 0)
  6932    . S DIR(" A")="ARE Y OU SURE YO U WANT TO  UNMATCH TH EM? ",DIR( 0)="YA"
  6933   "RTN","RCD PEM2",271, 0)
  6934    . D ^DIR  K DIR
  6935   "RTN","RCD PEM2",272, 0)
  6936    . I Y'=1  S RCQUIT=1  Q
  6937   "RTN","RCD PEM2",273, 0)
  6938    . S DIE=" ^RCY(344.3 1,",DR=".1 ///@;.08// //0",DA=RC EFT D ^DIE
  6939   "RTN","RCD PEM2",274, 0)
  6940    . W !,"EF T #"_$$OUT ^RCDPEM3(R CEFT)_" IS  NOW UNMAT CHED",!
  6941   "RTN","RCD PEM2",275, 0)
  6942    ; PRCA*4. 5*326 - If  check if  unmatched,  delete da te matched  and user
  6943   "RTN","RCD PEM2",276, 0)
  6944    S DIE="^R CY(344.4," ,DR=".09// //0;.13/// @;.14////0 ;5.03///@; 5.04///@"
  6945   "RTN","RCD PEM2",277, 0)
  6946    S DA=RCWL
  6947   "RTN","RCD PEM2",278, 0)
  6948    D ^DIE
  6949   "RTN","RCD PEM2",279, 0)
  6950    I AUTOPOS T=0 D SETS TA^RCDPEAP (RCWL,"@", "Unmatch:  Removed as  Auto-Post  Candidate ")
  6951   "RTN","RCD PEM2",280, 0)
  6952    S DIR("A" )="ERA HAS  BEEN SUCC ESSFULLY U NMATCHED -  Press ENT ER to cont inue: "
  6953   "RTN","RCD PEM2",281, 0)
  6954    S DIR(0)= "EA" W ! D  ^DIR K DI R
  6955   "RTN","RCD PEM2",282, 0)
  6956    Q
  6957   "RTN","RCD PEM2",283, 0)
  6958    ;
  6959   "RTN","RCD PEM2",284, 0)
  6960    ; PRCA*4. 5*284 - Ch anged opti on name fr om 'Mark E RA Return  to Payer'  to 'Remove  ERA from  Active Wor klist'
  6961   "RTN","RCD PEM2",285, 0)
  6962   RETN ; Ent rypoint fo r Remove E RA from Ac tive Workl ist
  6963   "RTN","RCD PEM2",286, 0)
  6964    N DIR,X,Y ,DTOUT,DUO UT,DIC,RCY ,DIE,DA,DR ,MSG,%
  6965   "RTN","RCD PEM2",287, 0)
  6966    D OWNSKEY ^XUSRB(.MS G,"RCDPE M ARK ERA",D UZ)
  6967   "RTN","RCD PEM2",288, 0)
  6968    I 'MSG(0)  W !!,"SOR RY, YOU AR E NOT AUTH ORIZED TO  USE THIS O PTION",!," This optio n is locke d with RCD PE MARK ER A key.",!  S DIR(0)=" E" D ^DIR  K DIR Q
  6969   "RTN","RCD PEM2",289, 0)
  6970    W !!,"Use  this opti on to remo ve an ERA  from the E EOB Workli st that sh ould not h ave"
  6971   "RTN","RCD PEM2",290, 0)
  6972    W !,"been  sent to y our site b y the paye r; or the  ERA cannot  be remove d off the"
  6973   "RTN","RCD PEM2",291, 0)
  6974    W !,"Work list using  the 'Upda te ERA Pos ted Using  Paper EOB'  option."
  6975   "RTN","RCD PEM2",292, 0)
  6976    W !!,"Thi s option i s only to  be used if  the paper  check has  been sent  back to t he"
  6977   "RTN","RCD PEM2",293, 0)
  6978    W !,"paye r without  being depo sited.  On ce removed , the ERA  can no lon ger be"
  6979   "RTN","RCD PEM2",294, 0)
  6980    W !,"acce ssed for p rocessing,  but can b e viewed u nder the p osted Work list. For"
  6981   "RTN","RCD PEM2",295, 0)
  6982    W !,"audi ting purpo ses, this  option req uires the  user to en ter a reas on for"
  6983   "RTN","RCD PEM2",296, 0)
  6984    W !,"remo ving the E RA.",!
  6985   "RTN","RCD PEM2",297, 0)
  6986    S DIC="^R CY(344.4," ,DIC(0)="A EMQ",DIC(" S")="I '$P (^(0),U,9) ,'$P(^(0), U,14)" D ^ DIC K DIC
  6987   "RTN","RCD PEM2",298, 0)
  6988    Q:Y'>0
  6989   "RTN","RCD PEM2",299, 0)
  6990    S RCY=+Y
  6991   "RTN","RCD PEM2",300, 0)
  6992    S DIR(0)= "YA",DIR(" A",1)="THI S WILL REM OVE THE ER A # "_+Y_"  FROM THE  ACTIVE WOR KLIST",DIR ("A")="ARE  YOU SURE  YOU WANT T O CONTINUE ? " W ! D  ^DIR K DIR
  6993   "RTN","RCD PEM2",301, 0)
  6994    W !
  6995   "RTN","RCD PEM2",302, 0)
  6996    I $D(DUOU T)!$D(DTOU T)!(Y=0) D  NOCHNG^RC DPEMB Q
  6997   "RTN","RCD PEM2",303, 0)
  6998    S DIE="^R CY(344.4," ,DA=RCY,DR =".18" D ^ DIE
  6999   "RTN","RCD PEM2",304, 0)
  7000    I $D(Y) D  NOCHNG^RC DPEMB Q
  7001   "RTN","RCD PEM2",305, 0)
  7002    ; PRCA*4. 5*284 Set  EFT MATCH  STATUS (#3 44.4,.09)  as '4' FOR  REMOVED r ather than  '2' FOR M ATCHED TO  PAPER CHEC K
  7003   "RTN","RCD PEM2",306, 0)
  7004    D NOW^%DT C S DR=".1 4////4;.09 ////4;.16/ ///"_DUZ_" ;.17////"_ % D ^DIE
  7005   "RTN","RCD PEM2",307, 0)
  7006    S DIR(0)= "EA",DIR(" A")="Press  ENTER to  continue:  "
  7007   "RTN","RCD PEM2",308, 0)
  7008    W ! D ^DI R
  7009   "RTN","RCD PEM2",309, 0)
  7010    Q
  7011   "RTN","RCD PEM4")
  7012   0^41^B2154 21276
  7013   "RTN","RCD PEM4",1,0)
  7014   RCDPEM4 ;O I D N
S           /PJH - EPA YMENTS AUD IT REPORTS  ;Nov 17,  2014@17:00 :41
  7015   "RTN","RCD PEM4",2,0)
  7016    ;;4.5;Acc ounts Rece ivable;**2 76,284,298 ,304,321,3 26,332**;M ar 20, 199 5;Build 34
  7017   "RTN","RCD PEM4",3,0)
  7018    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  7019   "RTN","RCD PEM4",4,0)
  7020    ;
  7021   "RTN","RCD PEM4",5,0)
  7022   EOB ; EEOB  Move/Copy /Rmove Aud it Report  [RCDPE EEO B MOVE/COP Y/RMOVE RP T]
  7023   "RTN","RCD PEM4",6,0)
  7024    N RCRTYP  S RCRTYP=" EOB"  ; re cord type
  7025   "RTN","RCD PEM4",7,0)
  7026    D ASKUSR
  7027   "RTN","RCD PEM4",8,0)
  7028    Q
  7029   "RTN","RCD PEM4",9,0)
  7030    ;
  7031   "RTN","RCD PEM4",10,0 )
  7032   POST ; ERA s Posted w ith Paper  EOB Audit  Report [RC DPE ERA W/ PAPER EOB  REPORT]
  7033   "RTN","RCD PEM4",11,0 )
  7034    N RCRTYP  S RCRTYP=" ERA"  ; re cord type
  7035   "RTN","RCD PEM4",12,0 )
  7036    D ASKUSR
  7037   "RTN","RCD PEM4",13,0 )
  7038    Q
  7039   "RTN","RCD PEM4",14,0 )
  7040    ;
  7041   "RTN","RCD PEM4",15,0 )
  7042   ASKUSR ;co llect filt er and dev ice option s
  7043   "RTN","RCD PEM4",16,0 )
  7044    Q:$G(RCRT YP)=""  ;  must have  record typ e
  7045   "RTN","RCD PEM4",17,0 )
  7046    N %ZIS,PO P,RCACT,RC DISPTY,RCD IV,RCDTRNG ,RCHDR,RCL STMGR,RCLN CNT,RCPGNU M,RCPROG,R CSTA,RCSTO P
  7047   "RTN","RCD PEM4",18,0 )
  7048    N RCTMPND ,RCTYPE,VA UTD,X,Y
  7049   "RTN","RCD PEM4",19,0 )
  7050    ; RCACT -  selected  actions fo r EOB
  7051   "RTN","RCD PEM4",20,0 )
  7052    ; RCDISPT Y - displa y type
  7053   "RTN","RCD PEM4",21,0 )
  7054    ; RCDIV -  selected  divs.
  7055   "RTN","RCD PEM4",22,0 )
  7056    ; RCDTRNG  - date ra nge for re port
  7057   "RTN","RCD PEM4",23,0 )
  7058    ; RCHDR -  header ar ray
  7059   "RTN","RCD PEM4",24,0 )
  7060    ; RCLSTMG R - ListMa n output f lag
  7061   "RTN","RCD PEM4",25,0 )
  7062    ; RCPGNUM  - report  page count
  7063   "RTN","RCD PEM4",26,0 )
  7064    ; RCPROG  - ^TMP sto rage node  for entrie s
  7065   "RTN","RCD PEM4",27,0 )
  7066    ; RCSTA -  station
  7067   "RTN","RCD PEM4",28,0 )
  7068    ; RCSTOP  - flag to  stop repor t
  7069   "RTN","RCD PEM4",29,0 )
  7070    ; RCTMPND  - ListMan  storage n ode
  7071   "RTN","RCD PEM4",30,0 )
  7072    ; RCTYPE  - Type of  EEOBs to i nclude M/P /T/A MEDIC AL/PHARMAC Y/TRICARE/ ALL
  7073   "RTN","RCD PEM4",31,0 )
  7074    ;
  7075   "RTN","RCD PEM4",32,0 )
  7076    S RCPROG= $T(+0),RCL STMGR="",R CACT="",(R CLNCNT,RCS TOP)=0,RCT MPND=""
  7077   "RTN","RCD PEM4",33,0 )
  7078    ; S (RCXC LUDE("CHAM PVA"),RCXC LUDE("TRIC ARE"))=0   ; default  to false
  7079   "RTN","RCD PEM4",34,0 )
  7080    ;Select D ate Range  for Report
  7081   "RTN","RCD PEM4",35,0 )
  7082    S RCDTRNG =$$DTRNG()  G:'RCDTRN G EXIT
  7083   "RTN","RCD PEM4",36,0 )
  7084    ;Select F ilter for  Action Typ e (Move,Co py,Remove  or All)
  7085   "RTN","RCD PEM4",37,0 )
  7086    I RCRTYP= "EOB" S RC ACT=$$ACTI ON G:RCACT <0 EXIT
  7087   "RTN","RCD PEM4",38,0 )
  7088    ;Select F ilter/Sort  by Divisi on
  7089   "RTN","RCD PEM4",39,0 )
  7090    D STADIV  G:'RCDIV E XIT
  7091   "RTN","RCD PEM4",40,0 )
  7092    ; Begin P RCA*4.5*32 6 Tricare  filter
  7093   "RTN","RCD PEM4",41,0 )
  7094    S RCTYPE= $$RTYPE^RC DPEU1("A")  I RCTYPE= -1 G EXIT
  7095   "RTN","RCD PEM4",42,0 )
  7096    ;
  7097   "RTN","RCD PEM4",43,0 )
  7098    ; Select  Display Ty pe , exit  if indicat ed
  7099   "RTN","RCD PEM4",44,0 )
  7100    S RCDISPT Y=$$DISPTY () G:RCDIS PTY<0 EXIT
  7101   "RTN","RCD PEM4",45,0 )
  7102    ;Display  capture in formation  for Excel,  set RCLST MGR to pre vent quest ion
  7103   "RTN","RCD PEM4",46,0 )
  7104    I RCDISPT Y D INFO^R CDPEM6 S R CLSTMGR="^ "
  7105   "RTN","RCD PEM4",47,0 )
  7106    I RCLSTMG R="" S RCL STMGR=$$AS KLM^RCDPEA RL G:RCLST MGR<0 EXIT
  7107   "RTN","RCD PEM4",48,0 )
  7108    I RCLSTMG R D  G EXI T
  7109   "RTN","RCD PEM4",49,0 )
  7110    .X "S RCT MPND=$T(+0 )_U_$$HDR" _RCRTYP K  ^TMP($J,RC TMPND)  ;  ^TMP stora ge node, c lean any r esidue
  7111   "RTN","RCD PEM4",50,0 )
  7112    .D RPRTCM PL
  7113   "RTN","RCD PEM4",51,0 )
  7114    .N H,L,HD R S L=0
  7115   "RTN","RCD PEM4",52,0 )
  7116    .X "S HDR (""TITLE"" )=$$HDR"_R CRTYP
  7117   "RTN","RCD PEM4",53,0 )
  7118    .F H=1:1: 7 I $D(RCH DR(H)) S L =H,HDR(H)= RCHDR(H)   ; take fir st 7 lines  of report  header
  7119   "RTN","RCD PEM4",54,0 )
  7120    .I $O(RCH DR(L)) D   ; any rema ining head er lines a t top of r eport
  7121   "RTN","RCD PEM4",55,0 )
  7122    ..N N S N =0,H=L F   S H=$O(RCH DR(H)) Q:' H  S N=N+. 001,^TMP($ J,RCTMPND, N)=RCHDR(H )
  7123   "RTN","RCD PEM4",56,0 )
  7124    .; invoke  ListMan
  7125   "RTN","RCD PEM4",57,0 )
  7126    .D LMRPT^ RCDPEARL(. HDR,$NA(^T MP($J,RCTM PND))) ; g enerate Li stMan disp lay
  7127   "RTN","RCD PEM4",58,0 )
  7128    ;
  7129   "RTN","RCD PEM4",59,0 )
  7130    ;Select o utput devi ce
  7131   "RTN","RCD PEM4",60,0 )
  7132    S %ZIS="Q M" D ^%ZIS  Q:POP
  7133   "RTN","RCD PEM4",61,0 )
  7134    ;Option t o queue
  7135   "RTN","RCD PEM4",62,0 )
  7136    I 'RCDISP TY,$D(IO(" Q")) D  Q
  7137   "RTN","RCD PEM4",63,0 )
  7138    .N ZTSK,Z TDESC,ZTSA VE,ZTQUEUE D,ZTRTN
  7139   "RTN","RCD PEM4",64,0 )
  7140    .S ZTRTN= "RPRTCMPL^ RCDPEM4"
  7141   "RTN","RCD PEM4",65,0 )
  7142    .S ZTDESC ="EDI LOCK BOX PAPER  EOB AUDIT  REPORT"
  7143   "RTN","RCD PEM4",66,0 )
  7144    .S ZTSAVE ("RC*")="" ,ZTSAVE("V AUTD")=""
  7145   "RTN","RCD PEM4",67,0 )
  7146    .D ^%ZTLO AD
  7147   "RTN","RCD PEM4",68,0 )
  7148    .W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_"  was queue d.",1:"Una ble to que ue this ta sk."),!
  7149   "RTN","RCD PEM4",69,0 )
  7150    .K ZTSK,I O("Q") D H OME^%ZIS
  7151   "RTN","RCD PEM4",70,0 )
  7152    ;
  7153   "RTN","RCD PEM4",71,0 )
  7154    ;Compile  and Print  Report
  7155   "RTN","RCD PEM4",72,0 )
  7156    D RPRTCMP L
  7157   "RTN","RCD PEM4",73,0 )
  7158    Q
  7159   "RTN","RCD PEM4",74,0 )
  7160    ;
  7161   "RTN","RCD PEM4",75,0 )
  7162   RPRTCMPL ; Compile an d print re port
  7163   "RTN","RCD PEM4",76,0 )
  7164    K ^TMP(RC PROG,$J),^ TMP($J,"RC  TOTAL")
  7165   "RTN","RCD PEM4",77,0 )
  7166    ;Scan ERA  file for  entries in  date rang e
  7167   "RTN","RCD PEM4",78,0 )
  7168    I RCRTYP= "ERA" D CM PLERA
  7169   "RTN","RCD PEM4",79,0 )
  7170    ;Scan EOB  file for  entries in  date rang e
  7171   "RTN","RCD PEM4",80,0 )
  7172    I RCRTYP= "EOB" D CM PLEOB
  7173   "RTN","RCD PEM4",81,0 )
  7174    ;Display  Report
  7175   "RTN","RCD PEM4",82,0 )
  7176    D DISP
  7177   "RTN","RCD PEM4",83,0 )
  7178    ;
  7179   "RTN","RCD PEM4",84,0 )
  7180   EXIT ;
  7181   "RTN","RCD PEM4",85,0 )
  7182    ;Clear ol d data
  7183   "RTN","RCD PEM4",86,0 )
  7184    K ^TMP(RC PROG,$J),^ TMP($J,"RC  TOTAL")
  7185   "RTN","RCD PEM4",87,0 )
  7186    Q
  7187   "RTN","RCD PEM4",88,0 )
  7188    ;
  7189   "RTN","RCD PEM4",89,0 )
  7190   CMPLERA ;G enerate th e ERA post ed with pa per EOB re port ^TMP  array
  7191   "RTN","RCD PEM4",90,0 )
  7192    ; ^RCY(34 4.4,0) = E LECTRONIC  REMITTANCE  ADVICE^34 4.4I^
  7193   "RTN","RCD PEM4",91,0 )
  7194    N START,E ND,ERAIEN, STA,STNAM, STNUM
  7195   "RTN","RCD PEM4",92,0 )
  7196    ;Date Ran ge
  7197   "RTN","RCD PEM4",93,0 )
  7198    S START=0 ,END="9999 999",SUB=0
  7199   "RTN","RCD PEM4",94,0 )
  7200    S:$P(RCDT RNG,U) STA RT=$P(RCDT RNG,U,2),E ND=$P(RCDT RNG,U,3)_" .24" ; PRC A*4.5*326  allow for  time at en d of date  range
  7201   "RTN","RCD PEM4",95,0 )
  7202    ;Selected  division  or All
  7203   "RTN","RCD PEM4",96,0 )
  7204    ;Scan AFL  index for  ERA withi n date ran ge
  7205   "RTN","RCD PEM4",97,0 )
  7206    F  S STAR T=$O(^RCY( 344.4,"AFL ",START))  Q:'START   Q:START>EN D  D
  7207   "RTN","RCD PEM4",98,0 )
  7208    .S ERAIEN =""
  7209   "RTN","RCD PEM4",99,0 )
  7210    .F  S ERA IEN=$O(^RC Y(344.4,"A FL",START, ERAIEN)) Q :'ERAIEN   D
  7211   "RTN","RCD PEM4",100, 0)
  7212    ..;Ignore  if not po sted with  paper EOB
  7213   "RTN","RCD PEM4",101, 0)
  7214    ..Q:'$D(^ RCY(344.4, ERAIEN,7))
  7215   "RTN","RCD PEM4",102, 0)
  7216    ..;Check  division
  7217   "RTN","RCD PEM4",103, 0)
  7218    ..D ERAST A(ERAIEN,. STA,.STNUM ,.STNAM)
  7219   "RTN","RCD PEM4",104, 0)
  7220    ..I RCDIV =2,'$D(VAU TD(STA)) Q
  7221   "RTN","RCD PEM4",105, 0)
  7222    ..I '$$IS TYPE^RCDPE U1(344.4,E RAIEN,RCTY PE) Q  ; P RCA*4.5*32 6 - M/P/T/ A filter
  7223   "RTN","RCD PEM4",106, 0)
  7224    ..;
  7225   "RTN","RCD PEM4",107, 0)
  7226    ..D SVERA ^RCDPEM41( ERAIEN,STA ,STNUM,STN AM)
  7227   "RTN","RCD PEM4",108, 0)
  7228    ;
  7229   "RTN","RCD PEM4",109, 0)
  7230    Q
  7231   "RTN","RCD PEM4",110, 0)
  7232    ;
  7233   "RTN","RCD PEM4",111, 0)
  7234   CMPLEOB ;G enerate th e EOB Move d/Copy/Rem ove report  ^TMP arra y
  7235   "RTN","RCD PEM4",112, 0)
  7236    N DTSUB,S TART,END,E OBIEN,IEN1 01,STA,STN AM,STNUM
  7237   "RTN","RCD PEM4",113, 0)
  7238    ;Date Ran ge
  7239   "RTN","RCD PEM4",114, 0)
  7240    S START=$ P(RCDTRNG, U,2),END=$ P(RCDTRNG, U,3)
  7241   "RTN","RCD PEM4",115, 0)
  7242    ;Selected  division  or All
  7243   "RTN","RCD PEM4",116, 0)
  7244    ;Scan AEO B index fo r EOB with in date ra nge
  7245   "RTN","RCD PEM4",117, 0)
  7246    F  S STAR T=$O(^IBM( 361.1,"AEO B",START))  Q:'START   Q:(START\ 1)>END  D
  7247   "RTN","RCD PEM4",118, 0)
  7248    .S EOBIEN =""
  7249   "RTN","RCD PEM4",119, 0)
  7250    .F  S EOB IEN=$O(^IB M(361.1,"A EOB",START ,EOBIEN))  Q:'EOBIEN   D
  7251   "RTN","RCD PEM4",120, 0)
  7252    ..; Ignor e if not M OVED/COPIE D
  7253   "RTN","RCD PEM4",121, 0)
  7254    ..S IEN10 1="" F  S  IEN101=$O( ^IBM(361.1 ,"AEOB",ST ART,EOBIEN ,IEN101))  Q:'IEN101   D  ;
  7255   "RTN","RCD PEM4",122, 0)
  7256    ...; Chec k division
  7257   "RTN","RCD PEM4",123, 0)
  7258    ...D EOBS TA(EOBIEN, .STA,.STNU M,.STNAM)
  7259   "RTN","RCD PEM4",124, 0)
  7260    ...I RCDI V=2,'$D(VA UTD(STA))  Q
  7261   "RTN","RCD PEM4",125, 0)
  7262    ...I '$$I STYPE^RCDP EU1(361.1, EOBIEN,RCT YPE) Q  ;  PRCA*4.5*3 26 - M/P/T /A filter
  7263   "RTN","RCD PEM4",126, 0)
  7264    ...;
  7265   "RTN","RCD PEM4",127, 0)
  7266    ...;
  7267   "RTN","RCD PEM4",128, 0)
  7268    ...D SVEO B^RCDPEM41 (EOBIEN,IE N101,STA,S TNUM,STNAM )
  7269   "RTN","RCD PEM4",129, 0)
  7270    ;
  7271   "RTN","RCD PEM4",130, 0)
  7272    Q
  7273   "RTN","RCD PEM4",131, 0)
  7274    ;
  7275   "RTN","RCD PEM4",132, 0)
  7276   DISP ; For mat the di splay for  screen/pri nter or MS  Excel
  7277   "RTN","RCD PEM4",133, 0)
  7278    N DVFLTR, IEN,RCNTRY ,SUB,Y
  7279   "RTN","RCD PEM4",134, 0)
  7280    ;Format D ivision Fi lter
  7281   "RTN","RCD PEM4",135, 0)
  7282    S DVFLTR= $S(RCRTYP= "EOB":"ALL  STATIONS/ DIVISIONS" ,1:"ALL")  I RCDIV=2  S DVFLTR=$ $LINE(.VAU TD)
  7283   "RTN","RCD PEM4",136, 0)
  7284    D:'RCLSTM GR HDRBLD   ; Report  header
  7285   "RTN","RCD PEM4",137, 0)
  7286    D:RCLSTMG R HDRLM  ;  Listman h eader
  7287   "RTN","RCD PEM4",138, 0)
  7288    ; RCNTRY  - entry fr om ^TMP(RC PROG,$J)
  7289   "RTN","RCD PEM4",139, 0)
  7290    ;
  7291   "RTN","RCD PEM4",140, 0)
  7292    U IO
  7293   "RTN","RCD PEM4",141, 0)
  7294    ;
  7295   "RTN","RCD PEM4",142, 0)
  7296    ; Display  Header fo r first ti me
  7297   "RTN","RCD PEM4",143, 0)
  7298    D:'RCLSTM GR HDRLST^ RCDPEARL(. RCSTOP,.RC HDR)
  7299   "RTN","RCD PEM4",144, 0)
  7300    ;Report b y division  or 'ALL'
  7301   "RTN","RCD PEM4",145, 0)
  7302    S SUB=0,R CSTOP=0
  7303   "RTN","RCD PEM4",146, 0)
  7304    F  S SUB= $O(^TMP(RC PROG,$J,SU B)) Q:SUB= ""!RCSTOP   D
  7305   "RTN","RCD PEM4",147, 0)
  7306    .S IEN=0  F  S IEN=$ O(^TMP(RCP ROG,$J,SUB ,IEN)) Q:' IEN!RCSTOP   S RCNTRY =^(IEN) D
  7307   "RTN","RCD PEM4",148, 0)
  7308    ..I RCDIS PTY W !,RC NTRY Q  ;  spreadshee t format
  7309   "RTN","RCD PEM4",149, 0)
  7310    ..I RCRTY P="ERA" D   ; ERA pos ted with p aper EOB
  7311   "RTN","RCD PEM4",150, 0)
  7312    ...I 'RCL STMGR,$Y>( IOSL-RCHDR (0)) D HDR LST^RCDPEA RL(.RCSTOP ,.RCHDR) Q :RCSTOP
  7313   "RTN","RCD PEM4",151, 0)
  7314    ...S Y=$$ PAD^RCDPEA RL($P(RCNT RY,U,5),11 )  ; ERA#
  7315   "RTN","RCD PEM4",152, 0)
  7316    ...S Y=Y_ $$PAD^RCDP EARL($P(RC NTRY,U,6), 13) ;RECEI PT#
  7317   "RTN","RCD PEM4",153, 0)
  7318    ...S Y=Y_ $$PAD^RCDP EARL($P(RC NTRY,U,3), 18) ;DATE/ TIME
  7319   "RTN","RCD PEM4",154, 0)
  7320    ...S Y=Y_ $$PAD^RCDP EARL($P(RC NTRY,U,4), 16) ;USER  LASTNAME,F IRSTNAME
  7321   "RTN","RCD PEM4",155, 0)
  7322    ...S Y=Y_ $P(RCNTRY, U,7) ;MATC H STATUS
  7323   "RTN","RCD PEM4",156, 0)
  7324    ...D SL^R CDPEARL(Y, .RCLNCNT,R CTMPND)
  7325   "RTN","RCD PEM4",157, 0)
  7326    ...D SL^R CDPEARL($J ("",61)_$P (RCNTRY,U, 8),.RCLNCN T,RCTMPND)  ;POST STA TUS
  7327   "RTN","RCD PEM4",158, 0)
  7328    ..;
  7329   "RTN","RCD PEM4",159, 0)
  7330    ..I RCRTY P="EOB" D   ; EOB Mov ed/Copied
  7331   "RTN","RCD PEM4",160, 0)
  7332    ...I 'RCL STMGR,$Y>( IOSL-RCHDR (0)) D HDR LST^RCDPEA RL(.RCSTOP ,.RCHDR) Q :RCSTOP
  7333   "RTN","RCD PEM4",161, 0)
  7334    ...S Y=$$ PAD^RCDPEA RL($P(RCNT RY,U,5),20 ) ; ORIGIN AL BILL
  7335   "RTN","RCD PEM4",162, 0)
  7336    ...S Y=Y_ $P(RCNTRY, U,8) ; TRA CE #
  7337   "RTN","RCD PEM4",163, 0)
  7338    ...D SL^R CDPEARL(Y, .RCLNCNT,R CTMPND)
  7339   "RTN","RCD PEM4",164, 0)
  7340    ...S Y=$$ PAD^RCDPEA RL($J("",6 )_$P(RCNTR Y,U,7),15)  ;ERA
  7341   "RTN","RCD PEM4",165, 0)
  7342    ...S Y=Y_ $$PAD^RCDP EARL($P(RC NTRY,U,3), 20) ;DATE/ TIME
  7343   "RTN","RCD PEM4",166, 0)
  7344    ...S Y=Y_ $$PAD^RCDP EARL($P(RC NTRY,U,12) ,15) ;MOVE D/COPIED/R EMOVED
  7345   "RTN","RCD PEM4",167, 0)
  7346    ...S Y=Y_ $$PAD^RCDP EARL("$"_$ P(RCNTRY,U ,9),11) ;P AYMENT AMO UNT
  7347   "RTN","RCD PEM4",168, 0)
  7348    ...S Y=Y_ $P(RCNTRY, U,4) ; USE R LASTNAME ,FIRSTNAME
  7349   "RTN","RCD PEM4",169, 0)
  7350    ...D SL^R CDPEARL(Y, .RCLNCNT,R CTMPND)
  7351   "RTN","RCD PEM4",170, 0)
  7352    ...D:$P(R CNTRY,U,12 )'="REMOVE D"
  7353   "RTN","RCD PEM4",171, 0)
  7354    ....S Y=$ $PAD^RCDPE ARL("New B ill: "_$P( RCNTRY,U,6 ),25) ;NEW  BILL
  7355   "RTN","RCD PEM4",172, 0)
  7356    ....S Y=Y _"Other Bi ll Number( s): "_$P(R CNTRY,U,11 ) ;OTHER B ILLS
  7357   "RTN","RCD PEM4",173, 0)
  7358    ....D SL^ RCDPEARL(Y ,.RCLNCNT, RCTMPND)
  7359   "RTN","RCD PEM4",174, 0)
  7360    ...;
  7361   "RTN","RCD PEM4",175, 0)
  7362    ...D WP($ P(RCNTRY,U ,10))  ; J ustificati on comment s
  7363   "RTN","RCD PEM4",176, 0)
  7364    ...D SL^R CDPEARL("" ,.RCLNCNT, RCTMPND)   ; skip a l ine
  7365   "RTN","RCD PEM4",177, 0)
  7366    .;
  7367   "RTN","RCD PEM4",178, 0)
  7368    .; end of  report
  7369   "RTN","RCD PEM4",179, 0)
  7370    .I 'RCSTO P D SL^RCD PEARL(" ", .RCLNCNT,R CTMPND),SL ^RCDPEARL( $$ENDORPRT ^RCDPEARL, .RCLNCNT,R CTMPND)
  7371   "RTN","RCD PEM4",180, 0)
  7372    ;
  7373   "RTN","RCD PEM4",181, 0)
  7374    D:'$D(^TM P(RCPROG,$ J))
  7375   "RTN","RCD PEM4",182, 0)
  7376    .D SL^RCD PEARL(" ", .RCLNCNT,R CTMPND)  ;  skip line
  7377   "RTN","RCD PEM4",183, 0)
  7378    .D SL^RCD PEARL("      *** NO R ECORDS TO  PRINT ***" ,.RCLNCNT, RCTMPND)
  7379   "RTN","RCD PEM4",184, 0)
  7380    ;
  7381   "RTN","RCD PEM4",185, 0)
  7382    ;Close de vice
  7383   "RTN","RCD PEM4",186, 0)
  7384    I '$D(ZTQ UEUED),'RC LSTMGR D ^ %ZISC
  7385   "RTN","RCD PEM4",187, 0)
  7386    S:$D(ZTQU EUED) ZTRE Q="@"
  7387   "RTN","RCD PEM4",188, 0)
  7388    Q
  7389   "RTN","RCD PEM4",189, 0)
  7390    ;
  7391   "RTN","RCD PEM4",190, 0)
  7392   LINE(VAUTD ) ;List se lected sta tions
  7393   "RTN","RCD PEM4",191, 0)
  7394    N LINE,SU B
  7395   "RTN","RCD PEM4",192, 0)
  7396    S LINE="" ,SUB=""
  7397   "RTN","RCD PEM4",193, 0)
  7398    F  S SUB= $O(VAUTD(S UB)) Q:'SU B  D
  7399   "RTN","RCD PEM4",194, 0)
  7400    .S LINE=L INE_$G(VAU TD(SUB))_" , "
  7401   "RTN","RCD PEM4",195, 0)
  7402    Q $E(LINE ,1,$L(LINE )-2)
  7403   "RTN","RCD PEM4",196, 0)
  7404    ;
  7405   "RTN","RCD PEM4",197, 0)
  7406   SELDIV(VAU TD,Z) ;Dev isions are  organized  as Z(1)=" DIV1,DIV2, ..., Z(2)= "DIVN,DIVN +1,... etc .
  7407   "RTN","RCD PEM4",198, 0)
  7408    ; Input:
  7409   "RTN","RCD PEM4",199, 0)
  7410    ;   VAUTD  (required /pass-by-r ef) - Divi sion(s) ar ray; resul t of call  to DIVISIO N^VAUTOMA
  7411   "RTN","RCD PEM4",200, 0)
  7412    ; Output:
  7413   "RTN","RCD PEM4",201, 0)
  7414    ;   Z (re quired/pas s-by-ref)  - reformat ted array  of divisio ns
  7415   "RTN","RCD PEM4",202, 0)
  7416    ;
  7417   "RTN","RCD PEM4",203, 0)
  7418    N SUB,CNT
  7419   "RTN","RCD PEM4",204, 0)
  7420    S CNT=1,Z (CNT)="DIV ISIONS: "
  7421   "RTN","RCD PEM4",205, 0)
  7422    I $D(VAUT D)=1 D  Q
  7423   "RTN","RCD PEM4",206, 0)
  7424    . S Z(CNT )=Z(CNT)_" ALL"
  7425   "RTN","RCD PEM4",207, 0)
  7426    .S Z(CNT) =$J("",80- $L(Z(CNT)) \2)_Z(CNT)
  7427   "RTN","RCD PEM4",208, 0)
  7428    I $D(VAUT D)>1,'VAUT D D
  7429   "RTN","RCD PEM4",209, 0)
  7430    .S SUB=VA UTD
  7431   "RTN","RCD PEM4",210, 0)
  7432    .F  S SUB =$O(VAUTD( SUB)) Q:'S UB  D
  7433   "RTN","RCD PEM4",211, 0)
  7434    ..I Z(CNT )="DIVISIO NS: " S Z( CNT)=Z(CNT )_VAUTD(SU B) Q
  7435   "RTN","RCD PEM4",212, 0)
  7436    ..S Z(CNT )=Z(CNT)_$ S(Z(CNT)]" ":",",1:"" )_VAUTD(SU B)
  7437   "RTN","RCD PEM4",213, 0)
  7438    ..I $L(Z( CNT))>50 S  Z(CNT)=$J ("",80-$L( Z(CNT))\2) _Z(CNT),CN T=CNT+1,Z( CNT)=""
  7439   "RTN","RCD PEM4",214, 0)
  7440    ;
  7441   "RTN","RCD PEM4",215, 0)
  7442    I Z(CNT)] "" S Z(CNT )=$J("",80 -$L(Z(CNT) )\2)_Z(CNT )
  7443   "RTN","RCD PEM4",216, 0)
  7444    I Z(CNT)= "" K Z(CNT )
  7445   "RTN","RCD PEM4",217, 0)
  7446    Q
  7447   "RTN","RCD PEM4",218, 0)
  7448    ;
  7449   "RTN","RCD PEM4",219, 0)
  7450   HDRBLD ; c reate the  report hea der
  7451   "RTN","RCD PEM4",220, 0)
  7452    ; returns  RCHDR, RC PGNUM, RCS TOP
  7453   "RTN","RCD PEM4",221, 0)
  7454    ;   RCHDR (0) = head er text li ne count
  7455   "RTN","RCD PEM4",222, 0)
  7456    ;   RCHDR ("XECUTE")  = M code  for page n umber
  7457   "RTN","RCD PEM4",223, 0)
  7458    ;   RCHDR ("RUNDATE" ) = date/t ime report  generated , external  format
  7459   "RTN","RCD PEM4",224, 0)
  7460    ;   RCPGN UM - page  counter
  7461   "RTN","RCD PEM4",225, 0)
  7462    ;   RCSTO P - flag t o exit
  7463   "RTN","RCD PEM4",226, 0)
  7464    ; INPUT: 
  7465   "RTN","RCD PEM4",227, 0)
  7466    ;   RCDIS PTY - Disp lay/print/ Excel flag
  7467   "RTN","RCD PEM4",228, 0)
  7468    ;   RCDTR NG - date  range
  7469   "RTN","RCD PEM4",229, 0)
  7470    ;   RCRTY P - Report  Type (EOB  or ERA)
  7471   "RTN","RCD PEM4",230, 0)
  7472    ;   VAUTD
  7473   "RTN","RCD PEM4",231, 0)
  7474    K RCHDR S  RCHDR("RU NDATE")=$$ NOW^RCDPEA RL,RCPGNUM =0,RCSTOP= 0
  7475   "RTN","RCD PEM4",232, 0)
  7476    ;
  7477   "RTN","RCD PEM4",233, 0)
  7478    I RCDISPT Y D  Q  ;  Excel form at, xecute  code is Q UIT, null  page numbe r
  7479   "RTN","RCD PEM4",234, 0)
  7480    .S RCHDR( 0)=1,RCHDR (1)="^^^", RCHDR("XEC UTE")="Q", RCPGNUM=""
  7481   "RTN","RCD PEM4",235, 0)
  7482    .S:RCRTYP ="ERA" RCH DR(1)="STA TION^STATI ON NUMBER^ DATE/TIME^ USER^ERA^R ECEIPT^MAT CH STATUS^ POSTED STA TUS"
  7483   "RTN","RCD PEM4",236, 0)
  7484    .S:RCRTYP ="EOB" RCH DR(1)="STA TION^STATI ON NUMBER^ DATE/TIME^ USER^ORIGI NAL BILL^N EW BILL^ER A#^TRACE#^ PAYMENT AM OUNT^JUSTI FICATION^O THER BILLS ^MOVED/COP IED"
  7485   "RTN","RCD PEM4",237, 0)
  7486    ;
  7487   "RTN","RCD PEM4",238, 0)
  7488    N START,E ND,MSG,DAT E,Y,DIV,HC NT,J
  7489   "RTN","RCD PEM4",239, 0)
  7490    S START=$ $FMTE^XLFD T($P(RCDTR NG,U,2),"2 Z"),END=$$ FMTE^XLFDT ($P(RCDTRN G,U,3),"2Z "),HCNT=0
  7491   "RTN","RCD PEM4",240, 0)
  7492    ;
  7493   "RTN","RCD PEM4",241, 0)
  7494    S RCHDR(0 )=0  ; hea der line c ount
  7495   "RTN","RCD PEM4",242, 0)
  7496    X "S Y=$$ HDR"_RCRTY P S HCNT=1
  7497   "RTN","RCD PEM4",243, 0)
  7498    ;
  7499   "RTN","RCD PEM4",244, 0)
  7500    I RCRTYP= "ERA" D
  7501   "RTN","RCD PEM4",245, 0)
  7502    .D HDRXEC (RCRTYP)   ; xecute c ode for li ne 1
  7503   "RTN","RCD PEM4",246, 0)
  7504    .S Y="Run  Date/Time : "_RCHDR( "RUNDATE")
  7505   "RTN","RCD PEM4",247, 0)
  7506    .S HCNT=H CNT+1,RCHD R(HCNT)=$J ("",80-$L( Y)\2)_Y
  7507   "RTN","RCD PEM4",248, 0)
  7508    .S Y="DIV ISIONS: "_ $S(VAUTD=1 :"ALL",1:D VFLTR)
  7509   "RTN","RCD PEM4",249, 0)
  7510    .S HCNT=H CNT+1,RCHD R(HCNT)=$J ("",80-$L( Y)\2)_Y
  7511   "RTN","RCD PEM4",250, 0)
  7512    .S Y="Dat e Range: " _START_" -  "_END_" ( DATE ERA U PDATED)"
  7513   "RTN","RCD PEM4",251, 0)
  7514    .S HCNT=H CNT+1,RCHD R(HCNT)=$J ("",80-$L( Y)\2)_Y
  7515   "RTN","RCD PEM4",252, 0)
  7516    .; PRCA*4 .5*326
  7517   "RTN","RCD PEM4",253, 0)
  7518    .S Y="MED ICAL/PHARM ACY/TRICAR E: "
  7519   "RTN","RCD PEM4",254, 0)
  7520    .S Y=Y_$S (RCTYPE="M ":"MEDICAL ",RCTYPE=" P":"PHARMA CY",RCTYPE ="T":"TRIC ARE",1:"AL L")
  7521   "RTN","RCD PEM4",255, 0)
  7522    .S HCNT=H CNT+1,RCHD R(HCNT)=$J ("",80-$L( Y)\2)_Y
  7523   "RTN","RCD PEM4",256, 0)
  7524    .S HCNT=H CNT+1,RCHD R(HCNT)=""
  7525   "RTN","RCD PEM4",257, 0)
  7526    .S HCNT=H CNT+1,RCHD R(HCNT)="                           Date/Ti me          User Who         EFT  Match Sta tus"
  7527   "RTN","RCD PEM4",258, 0)
  7528    .S HCNT=H CNT+1,RCHD R(HCNT)="E RA #       Receipt #     ERA Upd ated        Updated               Detail Po st Status"
  7529   "RTN","RCD PEM4",259, 0)
  7530    .S RCHDR( 0)=HCNT  ;  header li ne count
  7531   "RTN","RCD PEM4",260, 0)
  7532    ;
  7533   "RTN","RCD PEM4",261, 0)
  7534    I RCRTYP= "EOB" D
  7535   "RTN","RCD PEM4",262, 0)
  7536    .D HDRXEC (RCRTYP)   ; xecute c ode for li ne 1
  7537   "RTN","RCD PEM4",263, 0)
  7538    .S Y="Run  Date/Time : "_RCHDR( "RUNDATE")
  7539   "RTN","RCD PEM4",264, 0)
  7540    .S HCNT=H CNT+1,RCHD R(HCNT)=$J ("",80-$L( Y)\2)_Y
  7541   "RTN","RCD PEM4",265, 0)
  7542    .S Y="Div isions: "_ $S(VAUTD=1 :"ALL",1:D VFLTR)
  7543   "RTN","RCD PEM4",266, 0)
  7544    .S HCNT=H CNT+1,RCHD R(HCNT)=$J ("",80-$L( Y)\2)_Y
  7545   "RTN","RCD PEM4",267, 0)
  7546    .S Y="Dat e Range: " _START_" -  "_END_" ( Date EEOB  was Moved/ Copied/Rem oved)"
  7547   "RTN","RCD PEM4",268, 0)
  7548    .S HCNT=H CNT+1,RCHD R(HCNT)=$J ("",80-$L( Y)\2)_Y
  7549   "RTN","RCD PEM4",269, 0)
  7550    .; PRCA*4 .5*326
  7551   "RTN","RCD PEM4",270, 0)
  7552    .S Y="MED ICAL/PHARM ACY/TRICAR E: "
  7553   "RTN","RCD PEM4",271, 0)
  7554    .S Y=Y_$S (RCTYPE="M ":"MEDICAL ",RCTYPE=" P":"PHARMA CY",RCTYPE ="T":"TRIC ARE",1:"AL L")
  7555   "RTN","RCD PEM4",272, 0)
  7556    .S HCNT=H CNT+1,RCHD R(HCNT)=$J ("",80-$L( Y)\2)_Y
  7557   "RTN","RCD PEM4",273, 0)
  7558    .S Y=" Ac tion(s) Se lected: "_ $S(RCACT=" M":"MOVE", RCACT="C": "COPY",RCA CT="R":"RE MOVE",1:"A LL")
  7559   "RTN","RCD PEM4",274, 0)
  7560    .S HCNT=H CNT+1,RCHD R(HCNT)=$J ("",80-$L( Y)\2)_Y
  7561   "RTN","RCD PEM4",275, 0)
  7562    .S HCNT=H CNT+1,RCHD R(HCNT)=""
  7563   "RTN","RCD PEM4",276, 0)
  7564    .S HCNT=H CNT+1,RCHD R(HCNT)="O rig Bill#           T race #"
  7565   "RTN","RCD PEM4",277, 0)
  7566    .S HCNT=H CNT+1,RCHD R(HCNT)="                                      Moved/C opied/   T otal Amt   User Who M oved/"
  7567   "RTN","RCD PEM4",278, 0)
  7568    .S HCNT=H CNT+1,RCHD R(HCNT)="      ERA #      Date/T ime           Removed          P aid        Copied/Rem oved"
  7569   "RTN","RCD PEM4",279, 0)
  7570    .S RCHDR( 0)=HCNT  ;  header li ne count
  7571   "RTN","RCD PEM4",280, 0)
  7572    ;
  7573   "RTN","RCD PEM4",281, 0)
  7574    ; add row  of equal  signs, not  for ListM an
  7575   "RTN","RCD PEM4",282, 0)
  7576    S Y=RCHDR (0)+1,RCHD R(0)=Y,RCH DR(Y)=$TR( $J("",80), " ","=")
  7577   "RTN","RCD PEM4",283, 0)
  7578    Q
  7579   "RTN","RCD PEM4",284, 0)
  7580    ;
  7581   "RTN","RCD PEM4",285, 0)
  7582   HDRLM ; cr eate the L istman hea der
  7583   "RTN","RCD PEM4",286, 0)
  7584    ; returns  RCHDR
  7585   "RTN","RCD PEM4",287, 0)
  7586    ;   RCHDR (0) = head er text li ne count
  7587   "RTN","RCD PEM4",288, 0)
  7588    ; INPUT: 
  7589   "RTN","RCD PEM4",289, 0)
  7590    ;   RCDTR NG - date  range
  7591   "RTN","RCD PEM4",290, 0)
  7592    ;   VAUTD  - Divisio n  filter  value(s)
  7593   "RTN","RCD PEM4",291, 0)
  7594    N START,E ND,MSG,DAT E,Y,DIV,HC NT,J
  7595   "RTN","RCD PEM4",292, 0)
  7596    S START=$ $FMTE^XLFD T($P(RCDTR NG,U,2),"2 Z"),END=$$ FMTE^XLFDT ($P(RCDTRN G,U,3),"2Z "),HCNT=0
  7597   "RTN","RCD PEM4",293, 0)
  7598    ;
  7599   "RTN","RCD PEM4",294, 0)
  7600    S RCHDR(0 )=0  ; hea der line c ount
  7601   "RTN","RCD PEM4",295, 0)
  7602    X "S Y=$$ HDR"_RCRTY P
  7603   "RTN","RCD PEM4",296, 0)
  7604    I RCRTYP= "ERA" D
  7605   "RTN","RCD PEM4",297, 0)
  7606    .D HDRXEC (RCRTYP)   ; xecute c ode for li ne 1
  7607   "RTN","RCD PEM4",298, 0)
  7608    .S HCNT=1 ,RCHDR(HCN T)=""
  7609   "RTN","RCD PEM4",299, 0)
  7610    .S Y="Div isions: "_ $S(VAUTD=1 :"ALL",1:D VFLTR)_"      "
  7611   "RTN","RCD PEM4",300, 0)
  7612    .; PRCA*4 .5*326
  7613   "RTN","RCD PEM4",301, 0)
  7614    .S Y=Y_"M EDICAL/PHA RMACY/TRIC ARE: "
  7615   "RTN","RCD PEM4",302, 0)
  7616    .S Y=Y_$S (RCTYPE="M ":"MEDICAL ",RCTYPE=" P":"PHARMA CY",RCTYPE ="T":"TRIC ARE",1:"AL L")
  7617   "RTN","RCD PEM4",303, 0)
  7618    .S HCNT=H CNT+1,RCHD R(HCNT)=Y
  7619   "RTN","RCD PEM4",304, 0)
  7620    .S HCNT=H CNT+1,RCHD R(HCNT)=""
  7621   "RTN","RCD PEM4",305, 0)
  7622    .S Y="Dat e Range: " _START_" -  "_END_" ( DATE ERA U PDATED)"
  7623   "RTN","RCD PEM4",306, 0)
  7624    .S HCNT=H CNT+1,RCHD R(HCNT)=Y
  7625   "RTN","RCD PEM4",307, 0)
  7626    .S HCNT=H CNT+1,RCHD R(HCNT)=""
  7627   "RTN","RCD PEM4",308, 0)
  7628    .S HCNT=H CNT+1,RCHD R(HCNT)="                           Date/Ti me          User Who         EFT  Match Sta tus"
  7629   "RTN","RCD PEM4",309, 0)
  7630    .S HCNT=H CNT+1,RCHD R(HCNT)="E RA #       Receipt #     ERA Upd ated        Updated               Detail Po st Status"
  7631   "RTN","RCD PEM4",310, 0)
  7632    .S RCHDR( 0)=HCNT  ;  header li ne count
  7633   "RTN","RCD PEM4",311, 0)
  7634    ;
  7635   "RTN","RCD PEM4",312, 0)
  7636    I RCRTYP= "EOB" D
  7637   "RTN","RCD PEM4",313, 0)
  7638    .D HDRXEC (RCRTYP)   ; xecute c ode for li ne 1
  7639   "RTN","RCD PEM4",314, 0)
  7640    .S Y="Div isions: "_ $S(VAUTD=1 :"ALL",1:D VFLTR)_"      "
  7641   "RTN","RCD PEM4",315, 0)
  7642    .; PRCA*4 .5*326
  7643   "RTN","RCD PEM4",316, 0)
  7644    .S Y=Y_"M EDICAL/PHA RMACY/TRIC ARE: "
  7645   "RTN","RCD PEM4",317, 0)
  7646    .S Y=Y_$S (RCTYPE="M ":"MEDICAL ",RCTYPE=" P":"PHARMA CY",RCTYPE ="T":"TRIC ARE",1:"AL L")
  7647   "RTN","RCD PEM4",318, 0)
  7648    .S HCNT=1 ,RCHDR(HCN T)=Y
  7649   "RTN","RCD PEM4",319, 0)
  7650    .S Y="Dat e Range: " _START_" -  "_END_" ( Date EEOB  was Moved/ Copied/Rem oved)"
  7651   "RTN","RCD PEM4",320, 0)
  7652    .S HCNT=2 ,RCHDR(HCN T)=Y
  7653   "RTN","RCD PEM4",321, 0)
  7654    .S Y="Act ion(s) Sel ected: "_$ S(RCACT="M ":"MOVE",R CACT="C":" COPY",RCAC T="R":"REM OVE",1:"AL L")
  7655   "RTN","RCD PEM4",322, 0)
  7656    .S HCNT=3 ,RCHDR(HCN T)=Y
  7657   "RTN","RCD PEM4",323, 0)
  7658    .S HCNT=4 ,RCHDR(HCN T)=""
  7659   "RTN","RCD PEM4",324, 0)
  7660    .S HCNT=5 ,RCHDR(HCN T)="Orig B ill#           Trace  #"
  7661   "RTN","RCD PEM4",325, 0)
  7662    .S HCNT=6 ,RCHDR(HCN T)="                                     Mo ved/Copied /   Total  Amt  User  Who Moved/ "
  7663   "RTN","RCD PEM4",326, 0)
  7664    .S HCNT=7 ,RCHDR(HCN T)="     E RA #     D ate/Time           Re moved          Paid        Copie d/Removed"
  7665   "RTN","RCD PEM4",327, 0)
  7666    .S RCHDR( 0)=HCNT  ;  header li ne count
  7667   "RTN","RCD PEM4",328, 0)
  7668    ;
  7669   "RTN","RCD PEM4",329, 0)
  7670    ; add row  of equal  signs, not  for ListM an
  7671   "RTN","RCD PEM4",330, 0)
  7672    S:'RCLSTM GR Y=RCHDR (0)+1,RCHD R(0)=Y,RCH DR(Y)=" "_ $TR($J("", 78)," ","= ")
  7673   "RTN","RCD PEM4",331, 0)
  7674    Q
  7675   "RTN","RCD PEM4",332, 0)
  7676    ;
  7677   "RTN","RCD PEM4",333, 0)
  7678   HDREOB() ;  extrinsic  variable,  header fo r EOB repo rt
  7679   "RTN","RCD PEM4",334, 0)
  7680    Q "EEOB M ove/Copy/R emove - Au dit Report "
  7681   "RTN","RCD PEM4",335, 0)
  7682    ;
  7683   "RTN","RCD PEM4",336, 0)
  7684   HDRERA() ;  extrinsic  variable,  header fo r ERA repo rt
  7685   "RTN","RCD PEM4",337, 0)
  7686    Q "ERAs P osted with  Paper EOB  - Audit R eport"
  7687   "RTN","RCD PEM4",338, 0)
  7688    ;
  7689   "RTN","RCD PEM4",339, 0)
  7690   HDRXEC(TYP ) ; create  xecute co de for hea der
  7691   "RTN","RCD PEM4",340, 0)
  7692    S RCHDR(" XECUTE")=" N Y S RCPG NUM=RCPGNU M+1,Y=$$HD R"_TYP_"^" _$T(+0)_", RCHDR(1)=$ J("" "",80 -$L(Y)\2)_ Y"_"_""           Pag e: ""_RCPG NUM"
  7693   "RTN","RCD PEM4",341, 0)
  7694    Q
  7695   "RTN","RCD PEM4",342, 0)
  7696    ;
  7697   "RTN","RCD PEM4",343, 0)
  7698   DTRNG() ;  function,  return dat e range fo r a report
  7699   "RTN","RCD PEM4",344, 0)
  7700    N DIR,DUO UT,X,Y,RCS TART,RCEND
  7701   "RTN","RCD PEM4",345, 0)
  7702    D DATES(. RCSTART,.R CEND)
  7703   "RTN","RCD PEM4",346, 0)
  7704    Q:RCSTART =-1 0
  7705   "RTN","RCD PEM4",347, 0)
  7706    Q:RCSTART  "1^"_RCST ART_"^"_RC END
  7707   "RTN","RCD PEM4",348, 0)
  7708    Q:'RCSTAR T "0^^"
  7709   "RTN","RCD PEM4",349, 0)
  7710    Q 0
  7711   "RTN","RCD PEM4",350, 0)
  7712    ;
  7713   "RTN","RCD PEM4",351, 0)
  7714   DATES(BDAT E,EDATE) ; Get a date  range.
  7715   "RTN","RCD PEM4",352, 0)
  7716    S (BDATE, EDATE)=0
  7717   "RTN","RCD PEM4",353, 0)
  7718    S DIR("?" )="Enter t he latest  date of re ceipt of d eposit to  include on  the repor t."
  7719   "RTN","RCD PEM4",354, 0)
  7720    S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="St art date:  " D ^DIR K  DIR
  7721   "RTN","RCD PEM4",355, 0)
  7722    I $D(DTOU T)!$D(DUOU T)!(Y="")  S BDATE=-1  Q
  7723   "RTN","RCD PEM4",356, 0)
  7724    S BDATE=Y
  7725   "RTN","RCD PEM4",357, 0)
  7726    S DIR("?" )="Enter t he latest  date of re ceipt of d eposit to  include on  the repor t."
  7727   "RTN","RCD PEM4",358, 0)
  7728    S DIR("B" )=Y(0)
  7729   "RTN","RCD PEM4",359, 0)
  7730    S DIR(0)= "DAO^"_BDA TE_":"_DT_ ":APE",DIR ("A")="  E nd date: "  D ^DIR K  DIR
  7731   "RTN","RCD PEM4",360, 0)
  7732    I $D(DTOU T)!$D(DUOU T)!(Y="")  S BDATE=-1  Q
  7733   "RTN","RCD PEM4",361, 0)
  7734    S EDATE=Y
  7735   "RTN","RCD PEM4",362, 0)
  7736    Q
  7737   "RTN","RCD PEM4",363, 0)
  7738    ;
  7739   "RTN","RCD PEM4",364, 0)
  7740   STADIV ;Di vision/Sta tion Filte r/Sort
  7741   "RTN","RCD PEM4",365, 0)
  7742    ;
  7743   "RTN","RCD PEM4",366, 0)
  7744    ;Sort sel ection
  7745   "RTN","RCD PEM4",367, 0)
  7746    N DIR,DUO UT,Y
  7747   "RTN","RCD PEM4",368, 0)
  7748    S RCDIV=0
  7749   "RTN","RCD PEM4",369, 0)
  7750    ;
  7751   "RTN","RCD PEM4",370, 0)
  7752    ;Division  selection  - IA 664
  7753   "RTN","RCD PEM4",371, 0)
  7754    ;RETURNS  Y=-1 (quit ), VAUTD=1  (for all) ,VAUTD=0 ( selected d ivisions i n VAUTD)
  7755   "RTN","RCD PEM4",372, 0)
  7756    D DIVISIO N^VAUTOMA  Q:Y<0
  7757   "RTN","RCD PEM4",373, 0)
  7758    ;
  7759   "RTN","RCD PEM4",374, 0)
  7760    ;If ALL s elected
  7761   "RTN","RCD PEM4",375, 0)
  7762    I VAUTD=1  S RCDIV=1  Q
  7763   "RTN","RCD PEM4",376, 0)
  7764    ;If some  DIVISIONS  selected
  7765   "RTN","RCD PEM4",377, 0)
  7766    S RCDIV=2
  7767   "RTN","RCD PEM4",378, 0)
  7768    Q
  7769   "RTN","RCD PEM4",379, 0)
  7770    ;
  7771   "RTN","RCD PEM4",380, 0)
  7772   ACTION() ;  Get actio n type
  7773   "RTN","RCD PEM4",381, 0)
  7774    N DIR,X,Y ,DIROUT,DU OUT
  7775   "RTN","RCD PEM4",382, 0)
  7776    S DIR("A" )="Move/Co py/Remove  or All (M/ C/R/A): "
  7777   "RTN","RCD PEM4",383, 0)
  7778    S DIR("B" )="All"  ;  default t o ALL
  7779   "RTN","RCD PEM4",384, 0)
  7780    S DIR(0)= "SAB^M:Mov e;C:Copy;R :Remove;A: All"
  7781   "RTN","RCD PEM4",385, 0)
  7782    D ^DIR Q: $G(DIROUT) !$G(DUOUT)  -1
  7783   "RTN","RCD PEM4",386, 0)
  7784    ;
  7785   "RTN","RCD PEM4",387, 0)
  7786    Q Y
  7787   "RTN","RCD PEM4",388, 0)
  7788    ;
  7789   "RTN","RCD PEM4",389, 0)
  7790   DISPTY() ;  Get displ ay/output  type
  7791   "RTN","RCD PEM4",390, 0)
  7792    N DIR,DTO UT,DUOUT,X ,Y
  7793   "RTN","RCD PEM4",391, 0)
  7794    S DIR(0)= "YA"
  7795   "RTN","RCD PEM4",392, 0)
  7796    S DIR("A" )="Export  the report  to Micros oft Excel?  "
  7797   "RTN","RCD PEM4",393, 0)
  7798    S DIR("B" )="NO"
  7799   "RTN","RCD PEM4",394, 0)
  7800    D ^DIR I  $G(DUOUT)  Q -1
  7801   "RTN","RCD PEM4",395, 0)
  7802    Q Y
  7803   "RTN","RCD PEM4",396, 0)
  7804    ;
  7805   "RTN","RCD PEM4",397, 0)
  7806   ERASTA(ERA IEN,STA,ST NUM,STNAM)  ; Get the  station f or this ER A
  7807   "RTN","RCD PEM4",398, 0)
  7808    ; read al lowed on B ILL/CLAIMS  file (#39 9) via IA  3820
  7809   "RTN","RCD PEM4",399, 0)
  7810    ; returns  STA: stat ion IEN, S TNAM: stat ion name,  STNUM: sta tion numbe r
  7811   "RTN","RCD PEM4",400, 0)
  7812    N ERAEOB, ERABILL,ST AIEN
  7813   "RTN","RCD PEM4",401, 0)
  7814    S (ERAEOB ,ERABILL)= ""
  7815   "RTN","RCD PEM4",402, 0)
  7816    S (STA,ST NUM,STNAM) ="UNKNOWN"
  7817   "RTN","RCD PEM4",403, 0)
  7818    D
  7819   "RTN","RCD PEM4",404, 0)
  7820    .S ERAEOB =$P($G(^RC Y(344.4,ER AIEN,1,1,0 )),U,2) Q: 'ERAEOB  ;  if EOB po inter not  on first s ub-file en try then s top
  7821   "RTN","RCD PEM4",405, 0)
  7822    .S ERABIL L=$P($G(^I BM(361.1,E RAEOB,0)), U,1) Q:'ER ABILL  ; E XPLANATION  OF BENEFI TS file (# 361.1)
  7823   "RTN","RCD PEM4",406, 0)
  7824    .S STAIEN =$P($G(^DG CR(399,ERA BILL,0)),U ,22) Q:'ST AIEN  ;(#. 22) DEFAUL T DIVISION  [22P:40.8 ]
  7825   "RTN","RCD PEM4",407, 0)
  7826    .S STA=ST AIEN
  7827   "RTN","RCD PEM4",408, 0)
  7828    .S STNAM= $$EXTERNAL ^DILFD(399 ,.22,,STA)
  7829   "RTN","RCD PEM4",409, 0)
  7830    .S STNUM= $P($G(^DG( 40.8,STAIE N,0)),U,2)  ;IA 417
  7831   "RTN","RCD PEM4",410, 0)
  7832    ;
  7833   "RTN","RCD PEM4",411, 0)
  7834    Q
  7835   "RTN","RCD PEM4",412, 0)
  7836    ;
  7837   "RTN","RCD PEM4",413, 0)
  7838   EOBSTA(EOB IEN,STA,ST NUM,STNAM)  ; Get the  station f or this EO B
  7839   "RTN","RCD PEM4",414, 0)
  7840    ;Allowed  read on 39 9 via IA 3 820
  7841   "RTN","RCD PEM4",415, 0)
  7842    N BILL,ST AIEN
  7843   "RTN","RCD PEM4",416, 0)
  7844    S (BILL)= ""
  7845   "RTN","RCD PEM4",417, 0)
  7846    S (STA,ST NUM,STNAM) ="UNKNOWN"
  7847   "RTN","RCD PEM4",418, 0)
  7848    D
  7849   "RTN","RCD PEM4",419, 0)
  7850    .S BILL=$ P(^IBM(361 .1,EOBIEN, 0),U,1) Q: 'BILL
  7851   "RTN","RCD PEM4",420, 0)
  7852    .S STAIEN =$P($G(^DG CR(399,BIL L,0)),U,22 ) Q:'STAIE N
  7853   "RTN","RCD PEM4",421, 0)
  7854    .S STA=ST AIEN
  7855   "RTN","RCD PEM4",422, 0)
  7856    .S STNAM= $$EXTERNAL ^DILFD(399 ,.22,,STA)
  7857   "RTN","RCD PEM4",423, 0)
  7858    .S STNUM= $P($G(^DG( 40.8,STAIE N,0)),U,2)  ;IA 417
  7859   "RTN","RCD PEM4",424, 0)
  7860    Q
  7861   "RTN","RCD PEM4",425, 0)
  7862    ;
  7863   "RTN","RCD PEM4",426, 0)
  7864   DTPRB() ;  Get the St art Date t ype
  7865   "RTN","RCD PEM4",427, 0)
  7866    N DIR,DTO UT,DUOUT,D IRUT,DIROU T,X,Y
  7867   "RTN","RCD PEM4",428, 0)
  7868    S DIR(0)= "SABO^W:Da te Removed  from Work list;R:Dat e ERA Rece ived;B:Bot h Dates"
  7869   "RTN","RCD PEM4",429, 0)
  7870    S DIR("A" )="Select  Start Date  Type: "
  7871   "RTN","RCD PEM4",430, 0)
  7872    D ^DIR K  DIR
  7873   "RTN","RCD PEM4",431, 0)
  7874    I $D(DTOU T)!$D(DUOU T)!(Y="")  S Y=0
  7875   "RTN","RCD PEM4",432, 0)
  7876    Q Y
  7877   "RTN","RCD PEM4",433, 0)
  7878    ;
  7879   "RTN","RCD PEM4",434, 0)
  7880   WP(JC) ; f ormat just ification  comments
  7881   "RTN","RCD PEM4",435, 0)
  7882    ; JC - Ju stificatio n Comment
  7883   "RTN","RCD PEM4",436, 0)
  7884    I JC="" Q
  7885   "RTN","RCD PEM4",437, 0)
  7886    N PCS,I,C NTR,CMNT,Y
  7887   "RTN","RCD PEM4",438, 0)
  7888    ; PCS - N umber of "  " $pieces  in the co mment
  7889   "RTN","RCD PEM4",439, 0)
  7890    ; CNTR -  CMNT line  counter
  7891   "RTN","RCD PEM4",440, 0)
  7892    ; CMNT -  comment te xt to be d isplayed
  7893   "RTN","RCD PEM4",441, 0)
  7894    S PCS=$L( JC," "),CN TR=1,CMNT( CNTR)=" Ju stificatio n Comments : "
  7895   "RTN","RCD PEM4",442, 0)
  7896    F I=1:1:P CS D
  7897   "RTN","RCD PEM4",443, 0)
  7898    .S Y=$P(J C," ",I)
  7899   "RTN","RCD PEM4",444, 0)
  7900    .S:$L(CMN T(CNTR))+$ L(Y)>72 CN TR=CNTR+1, CMNT(CNTR) =$J(" ",25 )
  7901   "RTN","RCD PEM4",445, 0)
  7902    .S CMNT(C NTR)=CMNT( CNTR)_" "_ Y
  7903   "RTN","RCD PEM4",446, 0)
  7904    ;
  7905   "RTN","RCD PEM4",447, 0)
  7906    F I=1:1:C NTR D SL^R CDPEARL(CM NT(I),.RCL NCNT,RCTMP ND)
  7907   "RTN","RCD PEM4",448, 0)
  7908    Q
  7909   "RTN","RCD PEM4",449, 0)
  7910    ;
  7911   "RTN","RCD PEM5")
  7912   0^34^B1698 13342
  7913   "RTN","RCD PEM5",1,0)
  7914   RCDPEM5 ;A LB/PJH - E PAYMENTS M OVE EEOB T O NEW CLAI M ;Oct 29,  2014@16:4 3:51
  7915   "RTN","RCD PEM5",2,0)
  7916    ;;4.5;Acc ounts Rece ivable;**1 73,208,276 ,298,321,3 32**;Mar 2 0, 1995;Bu ild 34
  7917   "RTN","RCD PEM5",3,0)
  7918    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  7919   "RTN","RCD PEM5",4,0)
  7920    Q
  7921   "RTN","RCD PEM5",5,0)
  7922    ;
  7923   "RTN","RCD PEM5",6,0)
  7924   EN ;Entry  point for  EEOB Move/ Copy/Remov e [RCDPE E EOB MOVE/C OPY/REMOVE ] option
  7925   "RTN","RCD PEM5",7,0)
  7926    ;
  7927   "RTN","RCD PEM5",8,0)
  7928    N DIR,X,Y ,DIROUT,DU OUT,MODE
  7929   "RTN","RCD PEM5",9,0)
  7930    S DIR("A" )="Select  action"
  7931   "RTN","RCD PEM5",10,0 )
  7932    S DIR("B" )="M"
  7933   "RTN","RCD PEM5",11,0 )
  7934    S DIR(0)= "S^M:Move  EEOB to di fferent cl aim;"
  7935   "RTN","RCD PEM5",12,0 )
  7936    S DIR(0)= DIR(0)_"C: Copy EEOB  to multipl e claims;"
  7937   "RTN","RCD PEM5",13,0 )
  7938    S DIR(0)= DIR(0)_"R: Remove EEO B from cla im"
  7939   "RTN","RCD PEM5",14,0 )
  7940    D ^DIR Q: $G(DIROUT) !$G(DUOUT)
  7941   "RTN","RCD PEM5",15,0 )
  7942    S MODE=Y
  7943   "RTN","RCD PEM5",16,0 )
  7944    ;
  7945   "RTN","RCD PEM5",17,0 )
  7946    ; - PRCA* 4.5*298 -  OWNSKEY^XU SRB - Supp orted IA 3 277  
  7947   "RTN","RCD PEM5",18,0 )
  7948    I MODE="R " N MSG D  OWNSKEY^XU SRB(.MSG," RCDPE REMO VE EEOB",D UZ) I 'MSG (0) D  Q
  7949   "RTN","RCD PEM5",19,0 )
  7950    .W !!,"SO RRY, YOU A RE NOT AUT HORIZED TO  USE THIS  ACTION"
  7951   "RTN","RCD PEM5",20,0 )
  7952    .W !,"Thi s action i s locked w ith RCDPE  REMOVE EEO B key.",!
  7953   "RTN","RCD PEM5",21,0 )
  7954    .N DIR S  DIR(0)="E"  D ^DIR
  7955   "RTN","RCD PEM5",22,0 )
  7956    ;
  7957   "RTN","RCD PEM5",23,0 )
  7958    ;Read acc ess to fil e #361.1 u nder IA 40 51
  7959   "RTN","RCD PEM5",24,0 )
  7960    ;
  7961   "RTN","RCD PEM5",25,0 )
  7962    N DA,DIC, DIE,DIR,DR ,NCLAIM,OR IG,ORIGNAM ,X,Y
  7963   "RTN","RCD PEM5",26,0 )
  7964    ;
  7965   "RTN","RCD PEM5",27,0 )
  7966    ;Allow se lection of  a origina l third pa rty EOB
  7967   "RTN","RCD PEM5",28,0 )
  7968    S DIC("A" )="Select  EXPLANATIO N OF BENEF IT (EEOB)  to "_$S(MO DE="M":"MO VE",MODE=" R":"REMOVE ",1:"COPY" )_": "
  7969   "RTN","RCD PEM5",29,0 )
  7970    ; screen  to only al low select ion of an  active EEO B (not mar ked as del eted) and  non-MRA ty pe EOB
  7971   "RTN","RCD PEM5",30,0 )
  7972    S DIC("S" )="I ($P(^ (0),U,4)=0 )&('$P($G( ^(102)),U) )",DIC="^I BM(361.1," ,DIC(0)="A EMQ"
  7973   "RTN","RCD PEM5",31,0 )
  7974    W ! D ^DI C K DIC
  7975   "RTN","RCD PEM5",32,0 )
  7976    ;
  7977   "RTN","RCD PEM5",33,0 )
  7978    I Y'>0 Q
  7979   "RTN","RCD PEM5",34,0 )
  7980    ; control led subscr iption IA  1992
  7981   "RTN","RCD PEM5",35,0 )
  7982    S ORIG=+Y ,ORIGNAM=$ $GET1^DIQ( 399,$P(Y,U ,2),.01)
  7983   "RTN","RCD PEM5",36,0 )
  7984    ;
  7985   "RTN","RCD PEM5",37,0 )
  7986    ;Get curr ent bill p ayer seque nce from c laim - IA  3820
  7987   "RTN","RCD PEM5",38,0 )
  7988    D
  7989   "RTN","RCD PEM5",39,0 )
  7990    .N CURR,I EN399
  7991   "RTN","RCD PEM5",40,0 )
  7992    .S IEN399 =$P($G(^IB M(361.1,OR IG,0)),U)  Q:'IEN399
  7993   "RTN","RCD PEM5",41,0 )
  7994    .S CURR=$ P($G(^DGCR (399,IEN39 9,0)),U,21 ) I (CURR' ="T")&(CUR R'="S") Q
  7995   "RTN","RCD PEM5",42,0 )
  7996    .W !!,"Wa rning - se lected EEO B has seco ndary clai ms and may  have tert iary claim s"
  7997   "RTN","RCD PEM5",43,0 )
  7998    ;
  7999   "RTN","RCD PEM5",44,0 )
  8000    ;Lock Ori ginal EOB
  8001   "RTN","RCD PEM5",45,0 )
  8002    Q:'$$LOCK ^IBCEOB4(O RIG)
  8003   "RTN","RCD PEM5",46,0 )
  8004    ;
  8005   "RTN","RCD PEM5",47,0 )
  8006    ;Remove O ption
  8007   "RTN","RCD PEM5",48,0 )
  8008    I MODE="R " D REMOVE (ORIG,MODE ),EXIT Q
  8009   "RTN","RCD PEM5",49,0 )
  8010    ;
  8011   "RTN","RCD PEM5",50,0 )
  8012    ;Select C laim(s) to  Move/Copy  to
  8013   "RTN","RCD PEM5",51,0 )
  8014    N RCBILL, RCBILLNM,N CLAIM,NCLA IMX,QUIT,S UB,LIT
  8015   "RTN","RCD PEM5",52,0 )
  8016    S SUB=0,Q UIT=0,LIT= ""
  8017   "RTN","RCD PEM5",53,0 )
  8018    W !
  8019   "RTN","RCD PEM5",54,0 )
  8020    F  D  Q:Q UIT  Q:SUB &(MODE="M" )
  8021   "RTN","RCD PEM5",55,0 )
  8022    .;Allow s election o f a third  party clai m
  8023   "RTN","RCD PEM5",56,0 )
  8024    .I MODE=" M" S DIC(" A")="Selec t A/R Bill  to MOVE t o: "
  8025   "RTN","RCD PEM5",57,0 )
  8026    .I MODE=" C" S DIC(" A")="Selec t "_LIT_"A /R Bill to  COPY to:  "
  8027   "RTN","RCD PEM5",58,0 )
  8028    .S DIC="^ PRCA(430," ,DIC(0)="A EMQ",DIC(" S")="I $D( ^DGCR(399, +Y,0))&($$ VALSTAT^RC DPEM5(+Y)) "
  8029   "RTN","RCD PEM5",59,0 )
  8030    .D ^DIC K  DIC
  8031   "RTN","RCD PEM5",60,0 )
  8032    .I Y'>0 S  QUIT=1 Q
  8033   "RTN","RCD PEM5",61,0 )
  8034    .S RCBILL =+Y,RCBILL NM=$P($P(Y ,U,2),"-", 2)
  8035   "RTN","RCD PEM5",62,0 )
  8036    .I ORIGNA M=RCBILLNM ,MODE="M"  W !,"Canno t move EEO B to same  claim" Q
  8037   "RTN","RCD PEM5",63,0 )
  8038    .I $D(NCL AIMX(RCBIL L)) W !,"C laim alrea dy entered " Q
  8039   "RTN","RCD PEM5",64,0 )
  8040    .S SUB=SU B+1,NCLAIM (SUB)=RCBI LL,NCLAIMX (RCBILL)=" "
  8041   "RTN","RCD PEM5",65,0 )
  8042    .S:MODE=" C" LIT="an other "
  8043   "RTN","RCD PEM5",66,0 )
  8044    ;
  8045   "RTN","RCD PEM5",67,0 )
  8046    I $G(DUOU T)!$G(DIRO UT) D EXIT  Q
  8047   "RTN","RCD PEM5",68,0 )
  8048    ;
  8049   "RTN","RCD PEM5",69,0 )
  8050    ;User Exi t or no cl aims selec ted
  8051   "RTN","RCD PEM5",70,0 )
  8052    I '$O(NCL AIM("")) D  EXIT Q
  8053   "RTN","RCD PEM5",71,0 )
  8054    ;
  8055   "RTN","RCD PEM5",72,0 )
  8056    ;Prompt u ser to con tinue
  8057   "RTN","RCD PEM5",73,0 )
  8058    N DIR,X,Y ,DIROUT
  8059   "RTN","RCD PEM5",74,0 )
  8060    S DIR(0)= "Y",DIR("B ")="YES"
  8061   "RTN","RCD PEM5",75,0 )
  8062    S DIR("A" )=$$PROMPT (ORIG,.NCL AIM,MODE)
  8063   "RTN","RCD PEM5",76,0 )
  8064    W ! D ^DI R
  8065   "RTN","RCD PEM5",77,0 )
  8066    ;
  8067   "RTN","RCD PEM5",78,0 )
  8068    I $G(DIRO UT)!$G(DUO UT)!(Y=0)  D EXIT Q
  8069   "RTN","RCD PEM5",79,0 )
  8070    ;
  8071   "RTN","RCD PEM5",80,0 )
  8072    ;Enter Ju stificatio n Comment
  8073   "RTN","RCD PEM5",81,0 )
  8074    N DIR,DIR OUT,DUOUT, JCOM,X,Y
  8075   "RTN","RCD PEM5",82,0 )
  8076    S DIR(0)= "FA^1:100^ K:$TR(X,""  "","""")= """" X",DI R("A")="En ter JUSTIF ICATION CO MMENT: "
  8077   "RTN","RCD PEM5",83,0 )
  8078    W ! D ^DI R I $G(DIR OUT)!$G(DU OUT) W !!, "Update no t performe d" D EXIT  Q
  8079   "RTN","RCD PEM5",84,0 )
  8080    S JCOM=Y
  8081   "RTN","RCD PEM5",85,0 )
  8082    ;
  8083   "RTN","RCD PEM5",86,0 )
  8084    ;Update E OB
  8085   "RTN","RCD PEM5",87,0 )
  8086    D UPDATE( ORIG,.NCLA IM,MODE,JC OM),EXIT
  8087   "RTN","RCD PEM5",88,0 )
  8088    ;
  8089   "RTN","RCD PEM5",89,0 )
  8090    Q
  8091   "RTN","RCD PEM5",90,0 )
  8092    ;
  8093   "RTN","RCD PEM5",91,0 )
  8094    ;Unlock o riginal EO B
  8095   "RTN","RCD PEM5",92,0 )
  8096   EXIT D UNL OCK^IBCEOB 4(ORIG)
  8097   "RTN","RCD PEM5",93,0 )
  8098    Q
  8099   "RTN","RCD PEM5",94,0 )
  8100    ;
  8101   "RTN","RCD PEM5",95,0 )
  8102    ;File EOB  #361.1 ch anges - In tegration  Agreement  5671 for I BCEOB4
  8103   "RTN","RCD PEM5",96,0 )
  8104   UPDATE(ORI G,NCLAIM,M ODE,JUST)  ;
  8105   "RTN","RCD PEM5",97,0 )
  8106    ; Input -  ORIG - Or iginal EOB
  8107   "RTN","RCD PEM5",98,0 )
  8108    ;       -  NCLAIM -  New claim  (s)
  8109   "RTN","RCD PEM5",99,0 )
  8110    ;       -  MODE M=Mo ve C=Copy
  8111   "RTN","RCD PEM5",100, 0)
  8112    ;       -  JUST = Us er input j ustificati on text
  8113   "RTN","RCD PEM5",101, 0)
  8114    ; Output  -  Updates  EOB and A udit log
  8115   "RTN","RCD PEM5",102, 0)
  8116    N JUST1
  8117   "RTN","RCD PEM5",103, 0)
  8118    ;Move EOB
  8119   "RTN","RCD PEM5",104, 0)
  8120    I MODE="M " D
  8121   "RTN","RCD PEM5",105, 0)
  8122    .;Auto ge nerate tex t for AR c omments on  original  claim
  8123   "RTN","RCD PEM5",106, 0)
  8124    .S JUST1= $$JUST1(OR IG,.NCLAIM ,"M",0)
  8125   "RTN","RCD PEM5",107, 0)
  8126    .;Update  AR Comment s on the ' from bill'
  8127   "RTN","RCD PEM5",108, 0)
  8128    .D AUDIT^ RCDPAYER(O RIG,JUST_" ^"_JUST1,M ODE)
  8129   "RTN","RCD PEM5",109, 0)
  8130    .;Change  claim numb er on EEOB
  8131   "RTN","RCD PEM5",110, 0)
  8132    .D MOVE^I BCEOB4(ORI G,NCLAIM(1 ),DUZ,$$NO W^XLFDT,JU ST,MODE)
  8133   "RTN","RCD PEM5",111, 0)
  8134    .;Update  AR Comment s on 'to b ill'
  8135   "RTN","RCD PEM5",112, 0)
  8136    .D AUDIT^ RCDPAYER(O RIG,JUST_" ^"_JUST1,M ODE)
  8137   "RTN","RCD PEM5",113, 0)
  8138    ;Copy EOB
  8139   "RTN","RCD PEM5",114, 0)
  8140    I MODE="C " D
  8141   "RTN","RCD PEM5",115, 0)
  8142    .D COPY^I BCEOB4(ORI G,.NCLAIM, DUZ,$$NOW^ XLFDT,JUST ,MODE)
  8143   "RTN","RCD PEM5",116, 0)
  8144    .;Auto ge nerate tex t for AR c omments on  original  claim
  8145   "RTN","RCD PEM5",117, 0)
  8146    .S JUST1= $$JUST1(OR IG,.NCLAIM ,"C",0)
  8147   "RTN","RCD PEM5",118, 0)
  8148    .;Update  AR Comment s on origi nal claim
  8149   "RTN","RCD PEM5",119, 0)
  8150    .D AUDIT^ RCDPAYER(O RIG,JUST_" ^"_JUST1,M ODE)
  8151   "RTN","RCD PEM5",120, 0)
  8152    .;Auto ge nerate tex t for AR c omments on  new claim
  8153   "RTN","RCD PEM5",121, 0)
  8154    .S JUST1= $$JUST1(OR IG,.NCLAIM ,"C",1)
  8155   "RTN","RCD PEM5",122, 0)
  8156    .;Update  AR Comment s on new c laims
  8157   "RTN","RCD PEM5",123, 0)
  8158    .N SUB,NE WEOB
  8159   "RTN","RCD PEM5",124, 0)
  8160    .S SUB=0
  8161   "RTN","RCD PEM5",125, 0)
  8162    .F  S SUB =$O(NCLAIM (SUB)) Q:' SUB  D
  8163   "RTN","RCD PEM5",126, 0)
  8164    ..;Conver t Claim po inter to E OB pointer
  8165   "RTN","RCD PEM5",127, 0)
  8166    ..S NEWEO B=$O(^IBM( 361.1,"B", NCLAIM(SUB ),0)) Q:'N EWEOB
  8167   "RTN","RCD PEM5",128, 0)
  8168    ..D AUDIT ^RCDPAYER( NEWEOB,JUS T_"^"_JUST 1,MODE)
  8169   "RTN","RCD PEM5",129, 0)
  8170    W !!,"EEO B Update C omplete" H  1
  8171   "RTN","RCD PEM5",130, 0)
  8172    Q
  8173   "RTN","RCD PEM5",131, 0)
  8174    ;
  8175   "RTN","RCD PEM5",132, 0)
  8176   PROMPT(ORI G,NCLAIM,M ODE) ;Cons truct prom pt text
  8177   "RTN","RCD PEM5",133, 0)
  8178    ; Input -  ORIG - Or iginal EOB
  8179   "RTN","RCD PEM5",134, 0)
  8180    ;       -  NCLAIM -  New claim  (s)
  8181   "RTN","RCD PEM5",135, 0)
  8182    ;       -  MODE M=Mo ve C=Copy 
  8183   "RTN","RCD PEM5",136, 0)
  8184    ; Output  - Justific ation text
  8185   "RTN","RCD PEM5",137, 0)
  8186    ;
  8187   "RTN","RCD PEM5",138, 0)
  8188    N FIRST,S TR,STR1,SU B,TEXT
  8189   "RTN","RCD PEM5",139, 0)
  8190    ;Move or  copy text
  8191   "RTN","RCD PEM5",140, 0)
  8192    S TEXT=$$ EXTERNAL^D ILFD(361.1 ,.01,,$P($ G(^IBM(361 .1,ORIG,0) ),U))
  8193   "RTN","RCD PEM5",141, 0)
  8194    I MODE="M " S STR="M ove EEOB f rom claim  "_TEXT_" t o claim "
  8195   "RTN","RCD PEM5",142, 0)
  8196    E  S STR= "Copy EEOB  from clai m "_TEXT_"  to claim( s) "
  8197   "RTN","RCD PEM5",143, 0)
  8198    ;Build li st of clai ms
  8199   "RTN","RCD PEM5",144, 0)
  8200    S STR1="" ,SUB="",FI RST=1
  8201   "RTN","RCD PEM5",145, 0)
  8202    F  S SUB= $O(NCLAIM( SUB)) Q:'S UB  D
  8203   "RTN","RCD PEM5",146, 0)
  8204    .S TEXT=$ P($G(^PRCA (430,NCLAI M(SUB),0)) ,U)
  8205   "RTN","RCD PEM5",147, 0)
  8206    .I FIRST  S STR1=STR 1_$P(TEXT, "-",2),FIR ST=0 Q
  8207   "RTN","RCD PEM5",148, 0)
  8208    .S STR1=S TR1_", "_$ P(TEXT,"-" ,2)
  8209   "RTN","RCD PEM5",149, 0)
  8210    ;Return f ull prompt  text
  8211   "RTN","RCD PEM5",150, 0)
  8212    Q STR_STR 1_" "
  8213   "RTN","RCD PEM5",151, 0)
  8214    ;
  8215   "RTN","RCD PEM5",152, 0)
  8216   JUST(ORIG, NCLAIM,MOD E,TYPE,SRC ) ;Constru ct justifi cation tex t for auto matic upda tes
  8217   "RTN","RCD PEM5",153, 0)
  8218    ; Input -  ORIG - Or iginal EOB
  8219   "RTN","RCD PEM5",154, 0)
  8220    ;       -  NCLAIM -  New claim  (s)
  8221   "RTN","RCD PEM5",155, 0)
  8222    ;       -  MODE - "M " = Move " C" =Copy " R" = Remov e
  8223   "RTN","RCD PEM5",156, 0)
  8224    ;       -  TYPE - 0  = old EOB  1 = new EO B
  8225   "RTN","RCD PEM5",157, 0)
  8226    ;       -  SRC - "W"  = Worklis t "A" = Au to-post, " L" = Link  Payment  
  8227   "RTN","RCD PEM5",158, 0)
  8228    ; Output  - Justific ation text
  8229   "RTN","RCD PEM5",159, 0)
  8230    N FIRST,S TR,STR1,SU B,TEXT
  8231   "RTN","RCD PEM5",160, 0)
  8232    ;Original  bill numb er
  8233   "RTN","RCD PEM5",161, 0)
  8234    S TEXT=$$ EXTERNAL^D ILFD(361.1 ,.01,,$P($ G(^IBM(361 .1,ORIG,0) ),U))
  8235   "RTN","RCD PEM5",162, 0)
  8236    ;Justific ation comm ent for or iginal EOB
  8237   "RTN","RCD PEM5",163, 0)
  8238    I TYPE=0  D
  8239   "RTN","RCD PEM5",164, 0)
  8240    .I MODE=" R" S STR=" EEOB remov ed from cl aim "_TEXT ,STR1="" Q   ;PRCA*4. 5*321
  8241   "RTN","RCD PEM5",165, 0)
  8242    .I MODE=" M" S STR=" EEOB from  claim "_TE XT_" moved  to claim  "
  8243   "RTN","RCD PEM5",166, 0)
  8244    .I MODE=" C" S STR=" EEOB from  claim "_TE XT_" copie d to claim (s) "
  8245   "RTN","RCD PEM5",167, 0)
  8246    .;Build l ist of cla ims
  8247   "RTN","RCD PEM5",168, 0)
  8248    .S STR1=" ",SUB="",F IRST=1
  8249   "RTN","RCD PEM5",169, 0)
  8250    .F  S SUB =$O(NCLAIM (SUB)) Q:' SUB  D
  8251   "RTN","RCD PEM5",170, 0)
  8252    ..S TEXT= $P($G(^PRC A(430,NCLA IM(SUB),0) ),U)
  8253   "RTN","RCD PEM5",171, 0)
  8254    ..I FIRST  S STR1=ST R1_$P(TEXT ,"-",2),FI RST=0 Q
  8255   "RTN","RCD PEM5",172, 0)
  8256    ..S STR1= STR1_", "_ $P(TEXT,"- ",2)
  8257   "RTN","RCD PEM5",173, 0)
  8258    ;Justific ation comm ent for ne w EOB's
  8259   "RTN","RCD PEM5",174, 0)
  8260    I TYPE=1  D
  8261   "RTN","RCD PEM5",175, 0)
  8262    .I MODE=" M" S STR=" EEOB moved  from EEOB  for claim  "_TEXT,ST R1=""
  8263   "RTN","RCD PEM5",176, 0)
  8264    .I MODE=" C" S STR=" EEOB copie d from EEO B for clai m "_TEXT,S TR1=""
  8265   "RTN","RCD PEM5",177, 0)
  8266    ;Return f ull justif ication te xt
  8267   "RTN","RCD PEM5",178, 0)
  8268    Q STR_STR 1_" automa tically by  "_$S(SRC= "A":"Auto- post",SRC= "L":"Link  Payment",1 :"Worklist ")
  8269   "RTN","RCD PEM5",179, 0)
  8270    ;
  8271   "RTN","RCD PEM5",180, 0)
  8272   JUST1(ORIG ,NCLAIM,MO DE,TYPE) ; Construct  AR comment  for stand -alone MCR  option
  8273   "RTN","RCD PEM5",181, 0)
  8274    ; Input -  ORIG - Or iginal EOB
  8275   "RTN","RCD PEM5",182, 0)
  8276    ;       -  NCLAIM -  New claim  (s)
  8277   "RTN","RCD PEM5",183, 0)
  8278    ;       -  MODE M=Mo ve C=Copy
  8279   "RTN","RCD PEM5",184, 0)
  8280    ;       -  TYPE = 0  - original  EOB 1 - n ew EOB(s) 
  8281   "RTN","RCD PEM5",185, 0)
  8282    ; Output  - Justific ation text
  8283   "RTN","RCD PEM5",186, 0)
  8284    N FIRST,S TR,STR1,SU B,TEXT
  8285   "RTN","RCD PEM5",187, 0)
  8286    ;Original  bill numb er
  8287   "RTN","RCD PEM5",188, 0)
  8288    S TEXT=$$ EXTERNAL^D ILFD(361.1 ,.01,,$P($ G(^IBM(361 .1,ORIG,0) ),U))
  8289   "RTN","RCD PEM5",189, 0)
  8290    ;Justific ation comm ent for or iginal EOB
  8291   "RTN","RCD PEM5",190, 0)
  8292    I TYPE=0  D
  8293   "RTN","RCD PEM5",191, 0)
  8294    .I MODE=" M" S STR=" EEOB from  claim "_TE XT_" moved  to claim  "
  8295   "RTN","RCD PEM5",192, 0)
  8296    .I MODE=" C" S STR=" EEOB from  claim "_TE XT_" copie d to claim (s) "
  8297   "RTN","RCD PEM5",193, 0)
  8298    .;Build l ist of cla ims
  8299   "RTN","RCD PEM5",194, 0)
  8300    .S STR1=" ",SUB="",F IRST=1
  8301   "RTN","RCD PEM5",195, 0)
  8302    .F  S SUB =$O(NCLAIM (SUB)) Q:' SUB  D
  8303   "RTN","RCD PEM5",196, 0)
  8304    ..S TEXT= $P($G(^PRC A(430,NCLA IM(SUB),0) ),U)
  8305   "RTN","RCD PEM5",197, 0)
  8306    ..I FIRST  S STR1=ST R1_$P(TEXT ,"-",2),FI RST=0 Q
  8307   "RTN","RCD PEM5",198, 0)
  8308    ..S STR1= STR1_", "_ $P(TEXT,"- ",2)
  8309   "RTN","RCD PEM5",199, 0)
  8310    ;Justific ation comm ent for ne w EOB's
  8311   "RTN","RCD PEM5",200, 0)
  8312    I TYPE=1  D
  8313   "RTN","RCD PEM5",201, 0)
  8314    .I MODE=" M" S STR=" EEOB moved  from EEOB  for claim  "_TEXT,ST R1=""
  8315   "RTN","RCD PEM5",202, 0)
  8316    .I MODE=" C" S STR=" EEOB copie d from EEO B for clai m "_TEXT,S TR1=""
  8317   "RTN","RCD PEM5",203, 0)
  8318    ;Return c omment tex t
  8319   "RTN","RCD PEM5",204, 0)
  8320    Q STR_STR 1
  8321   "RTN","RCD PEM5",205, 0)
  8322    ;
  8323   "RTN","RCD PEM5",206, 0)
  8324   FINDEOB(IE N3444,BILL ) ;Find EO B for a cl aim within  an ERA
  8325   "RTN","RCD PEM5",207, 0)
  8326    ; Input -  IEN3444 =  ERA ien
  8327   "RTN","RCD PEM5",208, 0)
  8328    ;          BILL = Bi ll number
  8329   "RTN","RCD PEM5",209, 0)
  8330    ; Output  - IEN of E OB in #361 .1
  8331   "RTN","RCD PEM5",210, 0)
  8332    N IEN3611 ,SUB
  8333   "RTN","RCD PEM5",211, 0)
  8334    S (SUB,IE N3611)=0
  8335   "RTN","RCD PEM5",212, 0)
  8336    F  S SUB= $O(^RCY(34 4.4,IEN344 4,1,"AC",S UB)) Q:'SU B  D  Q:IE N3611
  8337   "RTN","RCD PEM5",213, 0)
  8338    .I $$EXTE RNAL^DILFD (344.41,.0 2,,SUB)=BI LL S IEN36 11=SUB
  8339   "RTN","RCD PEM5",214, 0)
  8340    Q IEN3611
  8341   "RTN","RCD PEM5",215, 0)
  8342    ;
  8343   "RTN","RCD PEM5",216, 0)
  8344   REMOVE(ORI G,MODE) ;  Interactiv e option t o Remove E EOB - PRCA *4.5*298
  8345   "RTN","RCD PEM5",217, 0)
  8346    ; Input -  ORIG = or iginal EOB  in #361.1
  8347   "RTN","RCD PEM5",218, 0)
  8348    ; Output  - mode = " R"
  8349   "RTN","RCD PEM5",219, 0)
  8350    ;
  8351   "RTN","RCD PEM5",220, 0)
  8352    ;Prompt u ser to con tinue
  8353   "RTN","RCD PEM5",221, 0)
  8354    N DIR,X,Y ,DIROUT
  8355   "RTN","RCD PEM5",222, 0)
  8356    S DIR(0)= "Y",DIR("B ")="YES"
  8357   "RTN","RCD PEM5",223, 0)
  8358    S DIR("A" )="Are you  sure you  want to re move EEOB  from claim  "_ORIGNAM _" (Y/N)?"
  8359   "RTN","RCD PEM5",224, 0)
  8360    W ! D ^DI R
  8361   "RTN","RCD PEM5",225, 0)
  8362    ;
  8363   "RTN","RCD PEM5",226, 0)
  8364    I $G(DIRO UT)!$G(DUO UT)!(Y=0)  Q
  8365   "RTN","RCD PEM5",227, 0)
  8366    ;
  8367   "RTN","RCD PEM5",228, 0)
  8368    ;Enter Ju stificatio n Comment
  8369   "RTN","RCD PEM5",229, 0)
  8370    N DIR,DIR OUT,DUOUT, JUST,X,Y
  8371   "RTN","RCD PEM5",230, 0)
  8372    S DIR(0)= "FA^1:100^ K:$TR(X,""  "","""")= """" X",DI R("A")="En ter JUSTIF ICATION CO MMENT: "
  8373   "RTN","RCD PEM5",231, 0)
  8374    W ! D ^DI R I $G(DIR OUT)!$G(DU OUT) W !!, "Update no t performe d" D EXIT  Q
  8375   "RTN","RCD PEM5",232, 0)
  8376    S JUST=Y
  8377   "RTN","RCD PEM5",233, 0)
  8378    ;
  8379   "RTN","RCD PEM5",234, 0)
  8380    ;Update E EOB
  8381   "RTN","RCD PEM5",235, 0)
  8382    D REMOVE^ IBCEOB4(OR IG,DUZ,JUS T)
  8383   "RTN","RCD PEM5",236, 0)
  8384    ;Update A R Comments  for remov ed claim
  8385   "RTN","RCD PEM5",237, 0)
  8386    D AUDIT^R CDPAYER(OR IG,JUST,MO DE)
  8387   "RTN","RCD PEM5",238, 0)
  8388    ;
  8389   "RTN","RCD PEM5",239, 0)
  8390    W !!,"EEO B Update C omplete" H  1
  8391   "RTN","RCD PEM5",240, 0)
  8392    Q
  8393   "RTN","RCD PEM5",241, 0)
  8394    ; 
  8395   "RTN","RCD PEM5",242, 0)
  8396   VALSTAT(CL IEN) ; val idation on  current s tatus of t he AR clai m selected  for the m ove/copy e vent  
  8397   "RTN","RCD PEM5",243, 0)
  8398    ; Claims  that are i n a incomp lete state  cannot be  selected
  8399   "RTN","RCD PEM5",244, 0)
  8400    ; incompl ete states  are deter mined at C URRENT STA TUS (8,430 ) of the A R claim
  8401   "RTN","RCD PEM5",245, 0)
  8402    ; AR clai ms with 'B ILL INCOMP LETE', 'IN COMPLETE',  'NEW BILL ' statuses  cannot be  selected 
  8403   "RTN","RCD PEM5",246, 0)
  8404    ; CLIEN=4 30 ien
  8405   "RTN","RCD PEM5",247, 0)
  8406    ; returns  0 or 1
  8407   "RTN","RCD PEM5",248, 0)
  8408    N CSTAT,F LAG
  8409   "RTN","RCD PEM5",249, 0)
  8410    S CSTAT=$ $GET1^DIQ( 430,CLIEN, 8)
  8411   "RTN","RCD PEM5",250, 0)
  8412    S FLAG=$S (CSTAT="BI LL INCOMPL ETE":0,CST AT="INCOMP LETE":0,CS TAT="NEW B ILL":0,1:1 )
  8413   "RTN","RCD PEM5",251, 0)
  8414    Q FLAG
  8415   "RTN","RCD PEM5",252, 0)
  8416    ;
  8417   "RTN","RCD PEM5",253, 0)
  8418    ; BEGIN -  PRCA*4.5* 321
  8419   "RTN","RCD PEM5",254, 0)
  8420   AUTO(OBILL ,RCSPLIT,R CERA,SRC,O RIG) ;EP f rom RCDPEM  and RCDPE MA
  8421   "RTN","RCD PEM5",255, 0)
  8422    ; Automat ic move co py of EOB
  8423   "RTN","RCD PEM5",256, 0)
  8424    ; Input:    OBILL        - Orig inal Bill  number in  #399 
  8425   "RTN","RCD PEM5",257, 0)
  8426    ;           RCSPLIT      - Arra y of split  lines
  8427   "RTN","RCD PEM5",258, 0)
  8428    ;           RCERA        - ERA  ien #344.4
  8429   "RTN","RCD PEM5",259, 0)
  8430    ;           SRC          - "W"  = Worklist  "A" = APA R/Autopost
  8431   "RTN","RCD PEM5",260, 0)
  8432    ;           ORIG         - IEN  of EOB in  file #361. 1
  8433   "RTN","RCD PEM5",261, 0)
  8434    ; Output  - Update E OBs and au dit trail
  8435   "RTN","RCD PEM5",262, 0)
  8436    N CCLAIM, FLAG,IFN,J ,NCLAIM,NB ILL,JUST,J UST1,SUB,S UB1,VALID  ; PRCA*4.5 *332
  8437   "RTN","RCD PEM5",263, 0)
  8438    ; EOB for  the origi nal claim  must be pr esent
  8439   "RTN","RCD PEM5",264, 0)
  8440    I 'ORIG Q  1
  8441   "RTN","RCD PEM5",265, 0)
  8442    S (SUB,SU B1)=0,VALI D=1 ; ; PR CA*4.5*332
  8443   "RTN","RCD PEM5",266, 0)
  8444    F J="O"," N","S" S F LAG(J)=0 ;  PRCA*4.5* 332 Initia lize flags  for origi nal, new a nd suspens e EEOBs
  8445   "RTN","RCD PEM5",267, 0)
  8446    ; Loop th rough spli t lines 
  8447   "RTN","RCD PEM5",268, 0)
  8448    F  S SUB= $O(RCSPLIT (SUB)) Q:' SUB  D
  8449   "RTN","RCD PEM5",269, 0)
  8450    . ; Bill  Number on  split line
  8451   "RTN","RCD PEM5",270, 0)
  8452    . S NBILL =$P(RCSPLI T(SUB),U,2 )
  8453   "RTN","RCD PEM5",271, 0)
  8454    . S IFN=$ P(RCSPLIT( SUB),U,7)    ; PRCA*4 .5*332
  8455   "RTN","RCD PEM5",272, 0)
  8456    . ; Ignor e split li nes with z ero value
  8457   "RTN","RCD PEM5",273, 0)
  8458    . Q:+$P(R CSPLIT(SUB ),U,3)=0
  8459   "RTN","RCD PEM5",274, 0)
  8460    . ; Suspe nse claims , piece 7  is pointer  to AR cla im file 43 0
  8461   "RTN","RCD PEM5",275, 0)
  8462    . I 'IFN  S FLAG("S" )=1 Q       ; PRCA*4. 5*332
  8463   "RTN","RCD PEM5",276, 0)
  8464    . ; Is or iginal bil l is in th e array?
  8465   "RTN","RCD PEM5",277, 0)
  8466    . I OBILL =NBILL S F LAG("O")=1  ; PRCA*4. 5*332
  8467   "RTN","RCD PEM5",278, 0)
  8468    . ; Save  POINTER to  AR Claim  file 430 ( DINUM to 3 99)
  8469   "RTN","RCD PEM5",279, 0)
  8470    . S SUB1= SUB1+1,NCL AIM(SUB1)= IFN
  8471   "RTN","RCD PEM5",280, 0)
  8472    . ; Build  list of n ew claims  to copy
  8473   "RTN","RCD PEM5",281, 0)
  8474    . I OBILL '=NBILL D     ; PRCA* 4.5*332
  8475   "RTN","RCD PEM5",282, 0)
  8476    . . S CCL AIM(IFN)=I FN ; PRCA* 4.5*332
  8477   "RTN","RCD PEM5",283, 0)
  8478    . . S FLA G("N")=1      ; PRCA* 4.5*332
  8479   "RTN","RCD PEM5",284, 0)
  8480    ;
  8481   "RTN","RCD PEM5",285, 0)
  8482    ; No new  claims. Pa yment must  have been  split to  suspense,  or suspens e and orig inal payme nt - no ac tion
  8483   "RTN","RCD PEM5",286, 0)
  8484    I 'FLAG(" N") Q 1 ;  PRCA*4.5*3 32
  8485   "RTN","RCD PEM5",287, 0)
  8486    ;
  8487   "RTN","RCD PEM5",288, 0)
  8488    ; Lock Or iginal EOB
  8489   "RTN","RCD PEM5",289, 0)
  8490    I '$$LOCK (ORIG) Q 0
  8491   "RTN","RCD PEM5",290, 0)
  8492    ;
  8493   "RTN","RCD PEM5",291, 0)
  8494    ; PRCA*4. 5*332 - St art modifi ed code bl ock
  8495   "RTN","RCD PEM5",292, 0)
  8496    ; If spli t to singl e new clai m move EOB  - i.e. ch ange claim  number on  EOB
  8497   "RTN","RCD PEM5",293, 0)
  8498    I SUB1=1, 'FLAG("S")  D  ;
  8499   "RTN","RCD PEM5",294, 0)
  8500    . ; Chang e claim nu mber on or iginal EOB  attached  to ERA
  8501   "RTN","RCD PEM5",295, 0)
  8502    . D AUTOM OVE(ORIG,. NCLAIM,SRC ) ; PRCA*4 .5*332
  8503   "RTN","RCD PEM5",296, 0)
  8504    ;
  8505   "RTN","RCD PEM5",297, 0)
  8506    ; Split w as to mult iple new c laims or n ew claim(s ) and susp ense - cop y original  EOB to ne w claim(s)
  8507   "RTN","RCD PEM5",298, 0)
  8508    E  D  ;
  8509   "RTN","RCD PEM5",299, 0)
  8510    . ; Copy  EOB to new  EOBs for  "to" claim s
  8511   "RTN","RCD PEM5",300, 0)
  8512    . D AUTOC OPY(ORIG,. CCLAIM,SRC ) ; PRCA*4 .5*332
  8513   "RTN","RCD PEM5",301, 0)
  8514    . ; If no  money wen t to suspe nse or the  original  EOB
  8515   "RTN","RCD PEM5",302, 0)
  8516    . ; mark  original E OB removed  but with  text of 'c opied to c laims....'
  8517   "RTN","RCD PEM5",303, 0)
  8518    . I 'FLAG ("O"),'FLA G("S") D    ;
  8519   "RTN","RCD PEM5",304, 0)
  8520    . . S JUS T=$$JUST(O RIG,.CCLAI M,"C",0,SR C)_" then  removed"
  8521   "RTN","RCD PEM5",305, 0)
  8522    . . D AUT OREM(ORIG, JUST)
  8523   "RTN","RCD PEM5",306, 0)
  8524    ; PRCA*4. 5*332 - En d modified  code bloc k
  8525   "RTN","RCD PEM5",307, 0)
  8526    ;
  8527   "RTN","RCD PEM5",308, 0)
  8528    D UNLOCK( ORIG)
  8529   "RTN","RCD PEM5",309, 0)
  8530    Q 1
  8531   "RTN","RCD PEM5",310, 0)
  8532    ;
  8533   "RTN","RCD PEM5",311, 0)
  8534   AUTOREM(OR IG,JUST) ; Silent rem ove of EEO B where en tire payme nt is susp ensed or m oved to ot her claims
  8535   "RTN","RCD PEM5",312, 0)
  8536    ; Input -  ORIG = EO B in #361. 1
  8537   "RTN","RCD PEM5",313, 0)
  8538    ;          JUST = Ju stificatio n text
  8539   "RTN","RCD PEM5",314, 0)
  8540    ; Output  - Update E OB in #361 .1 and aud it trail
  8541   "RTN","RCD PEM5",315, 0)
  8542    ;
  8543   "RTN","RCD PEM5",316, 0)
  8544    ;Lock Ori ginal EOB
  8545   "RTN","RCD PEM5",317, 0)
  8546    I '$$LOCK (ORIG) Q
  8547   "RTN","RCD PEM5",318, 0)
  8548    ;Update E EOB
  8549   "RTN","RCD PEM5",319, 0)
  8550    D REMOVE^ IBCEOB4(OR IG,DUZ,JUS T)
  8551   "RTN","RCD PEM5",320, 0)
  8552    ;Update A R Comments  for remov ed claim
  8553   "RTN","RCD PEM5",321, 0)
  8554    D AUDIT^R CDPAYER(OR IG,JUST,"R ")
  8555   "RTN","RCD PEM5",322, 0)
  8556    ;Unlock o riginal EO B
  8557   "RTN","RCD PEM5",323, 0)
  8558    D UNLOCK( ORIG)
  8559   "RTN","RCD PEM5",324, 0)
  8560    ;
  8561   "RTN","RCD PEM5",325, 0)
  8562    Q
  8563   "RTN","RCD PEM5",326, 0)
  8564    ;
  8565   "RTN","RCD PEM5",327, 0)
  8566   AUTOCOPY(O RIG,CCLAIM ,SRC) ; EP  from RCDP EU2 - Copy  EOBs and  upate AR T RANSACTION  file - PR CA*4.5*332
  8567   "RTN","RCD PEM5",328, 0)
  8568    ; Input:  ORIG  - IE N for file  361.1 of  original E OB
  8569   "RTN","RCD PEM5",329, 0)
  8570    ;         CCLAIM - A rray of cl aims to co py to
  8571   "RTN","RCD PEM5",330, 0)
  8572    ;         SRC   - "W " = Workli st "A" = A PAR/Autopo st "L" = L ink Paymen ts
  8573   "RTN","RCD PEM5",331, 0)
  8574    N JUST,JU ST1,MODE,S UB,NEWEOB
  8575   "RTN","RCD PEM5",332, 0)
  8576    S MODE=$S (SRC="L":" L",1:"W")
  8577   "RTN","RCD PEM5",333, 0)
  8578    S JUST=$$ JUST(ORIG, .CCLAIM,"C ",0,SRC) ;  Text for  original E EOB (copie d to claim s x,y,z -  then remov ed)
  8579   "RTN","RCD PEM5",334, 0)
  8580    S JUST1=$ $JUST(ORIG ,.CCLAIM," C",1,SRC)  ; Text for  copied to  EEOB (cop ied from c laim w)
  8581   "RTN","RCD PEM5",335, 0)
  8582    ; Copy EO B to new E OBs for "t o" claims
  8583   "RTN","RCD PEM5",336, 0)
  8584    D COPY^IB CEOB4(ORIG ,.CCLAIM,D UZ,$$NOW^X LFDT,JUST1 ,"C")
  8585   "RTN","RCD PEM5",337, 0)
  8586    ;
  8587   "RTN","RCD PEM5",338, 0)
  8588    ; Auto ge nerate tex t for AR c omments on  original  claim
  8589   "RTN","RCD PEM5",339, 0)
  8590    D AUDIT^R CDPAYER(OR IG,JUST,MO DE)
  8591   "RTN","RCD PEM5",340, 0)
  8592    ; Auto ge nerate tex t for AR c omments on  new claim
  8593   "RTN","RCD PEM5",341, 0)
  8594    S SUB=0
  8595   "RTN","RCD PEM5",342, 0)
  8596    F  S SUB= $O(CCLAIM( SUB)) Q:'S UB  D
  8597   "RTN","RCD PEM5",343, 0)
  8598    . ; Conve rt Claim p ointer to  EOB pointe r
  8599   "RTN","RCD PEM5",344, 0)
  8600    . S NEWEO B=$O(^IBM( 361.1,"B", CCLAIM(SUB ),""),-1)  Q:'NEWEOB
  8601   "RTN","RCD PEM5",345, 0)
  8602    . D AUDIT ^RCDPAYER( NEWEOB,JUS T1,MODE)
  8603   "RTN","RCD PEM5",346, 0)
  8604    Q
  8605   "RTN","RCD PEM5",347, 0)
  8606    ;
  8607   "RTN","RCD PEM5",348, 0)
  8608   AUTOMOVE(O RIG,NCLAIM ,SRC) ; EP  from RCDP EU2 - Move  EOB from  one claim  to another  PRCA*4.5* 332
  8609   "RTN","RCD PEM5",349, 0)
  8610    ; Input:  ORIG  - IE N for file  361.1 of  original E OB
  8611   "RTN","RCD PEM5",350, 0)
  8612    ;         NCLAIM - A rray of ne w claims
  8613   "RTN","RCD PEM5",351, 0)
  8614    ;         SRC   - "W " = Workli st "A" = A PAR/Autopo st "L" = L ink Paymen ts
  8615   "RTN","RCD PEM5",352, 0)
  8616    N JUST,JU ST1,MODE,S UB
  8617   "RTN","RCD PEM5",353, 0)
  8618    S MODE=$S (SRC="L":" L",1:"W")
  8619   "RTN","RCD PEM5",354, 0)
  8620    S JUST=$$ JUST(ORIG, .NCLAIM,"M ",0,SRC) ; Just. Text  for origi nal claim
  8621   "RTN","RCD PEM5",355, 0)
  8622    S JUST1=$ $JUST(ORIG ,.NCLAIM," M",1,SRC)  ;Just. Tex t for new  claim
  8623   "RTN","RCD PEM5",356, 0)
  8624    ; Update  AR Transac tion for o riginal cl aim
  8625   "RTN","RCD PEM5",357, 0)
  8626    D AUDIT^R CDPAYER(OR IG,JUST,MO DE)
  8627   "RTN","RCD PEM5",358, 0)
  8628    ; Change  claim numb er on orig inal EOB a ttached to  ERA
  8629   "RTN","RCD PEM5",359, 0)
  8630    D MOVE^IB CEOB4(ORIG ,NCLAIM(1) ,DUZ,$$NOW ^XLFDT,JUS T,"M")
  8631   "RTN","RCD PEM5",360, 0)
  8632    ; Update  AR Transac tion for n ew claim
  8633   "RTN","RCD PEM5",361, 0)
  8634    D AUDIT^R CDPAYER(OR IG,JUST1,M ODE)
  8635   "RTN","RCD PEM5",362, 0)
  8636    Q
  8637   "RTN","RCD PEM5",363, 0)
  8638    ;
  8639   "RTN","RCD PEM5",364, 0)
  8640    ;Read acc ess to fil e #361.1 u nder IA 40 51
  8641   "RTN","RCD PEM5",365, 0)
  8642   LOCK(EOBIE N) ;Lock O riginal EO B
  8643   "RTN","RCD PEM5",366, 0)
  8644    L +^IBM(3 61.1,EOBIE N):5 I  Q  1
  8645   "RTN","RCD PEM5",367, 0)
  8646    Q 0
  8647   "RTN","RCD PEM5",368, 0)
  8648    ;
  8649   "RTN","RCD PEM5",369, 0)
  8650   UNLOCK(EOB IEN) ;Rele ase EOB
  8651   "RTN","RCD PEM5",370, 0)
  8652    L -^IBM(3 61.1,EOBIE N)
  8653   "RTN","RCD PEM5",371, 0)
  8654    Q
  8655   "RTN","RCD PEM5",372, 0)
  8656    ; END PRC A*4.5*321
  8657   "RTN","RCD PEM5",373, 0)
  8658    ;
  8659   "RTN","RCD PEM5",374, 0)
  8660    ;US1394 A DDITIONS -  EP RCDPRP L1 and RCD PLPL3
  8661   "RTN","RCD PEM5",375, 0)
  8662   EEOB(RCRCP T,RCTRANDA ) ; Option  to restor e associat ed suspend ed/removed  EEOB
  8663   "RTN","RCD PEM5",376, 0)
  8664    ;
  8665   "RTN","RCD PEM5",377, 0)
  8666    ; INPUT   - RCRCPT -  Receipt i en #344
  8667   "RTN","RCD PEM5",378, 0)
  8668    ;         - RCTRANDA  - Receipt  line #344 .01
  8669   "RTN","RCD PEM5",379, 0)
  8670    ;
  8671   "RTN","RCD PEM5",380, 0)
  8672    ; OUTPUT  - RCEEOB -  selected  EEOB ien # 361.1 
  8673   "RTN","RCD PEM5",381, 0)
  8674    ; or 0 if  no EEOB
  8675   "RTN","RCD PEM5",382, 0)
  8676    ; or -1 i f ^ abort 
  8677   "RTN","RCD PEM5",383, 0)
  8678    ;
  8679   "RTN","RCD PEM5",384, 0)
  8680    N CLAIM,D IROUT,DTOU T,DUOUT,RC EEOB,RCEEO BH,RCERA,R CLINE
  8681   "RTN","RCD PEM5",385, 0)
  8682    ; Get new  claim IEN  from rece ipt line
  8683   "RTN","RCD PEM5",386, 0)
  8684    S CLAIM=$ $GET1^DIQ( 344.01,RCT RANDA_","_ RCRCPT_"," ,.09,"I")
  8685   "RTN","RCD PEM5",387, 0)
  8686    ; Quit if  this is n ot a third  party cla im payment
  8687   "RTN","RCD PEM5",388, 0)
  8688    Q:CLAIM'[ "PRCA" 0
  8689   "RTN","RCD PEM5",389, 0)
  8690    ; Check i f ERA has  a suspende d EEOB for  this line
  8691   "RTN","RCD PEM5",390, 0)
  8692    S RCEEOB= $$SUSP(RCR CPT,RCTRAN DA,.RCERA, .RCLINE)
  8693   "RTN","RCD PEM5",391, 0)
  8694    ; If no s uspended E EOB skip p rompt
  8695   "RTN","RCD PEM5",392, 0)
  8696    Q:'RCEEOB  0
  8697   "RTN","RCD PEM5",393, 0)
  8698    ;
  8699   "RTN","RCD PEM5",394, 0)
  8700    ; Get las t move/cop y history  record - R ead access  to file # 361.1 unde r IA 4051
  8701   "RTN","RCD PEM5",395, 0)
  8702    S RCEEOBH =$O(^IBM(3 61.1,RCEEO B,101,"A") ,-1)
  8703   "RTN","RCD PEM5",396, 0)
  8704    ; Quit if  EEOB if n o history  found - sh ould not o ccur since  EEOB is s uspended
  8705   "RTN","RCD PEM5",397, 0)
  8706    Q:'RCEEOB H 0
  8707   "RTN","RCD PEM5",398, 0)
  8708    ; Display  EOB detai l
  8709   "RTN","RCD PEM5",399, 0)
  8710    W !!,"Thi s claim ha s an assoc iated EEOB  on ERA "_ RCERA
  8711   "RTN","RCD PEM5",400, 0)
  8712    W !!,"Cla im Number      : ",$$ GET1^DIQ(3 44.41,RCLI NE_","_RCE RA,.02,"E" )
  8713   "RTN","RCD PEM5",401, 0)
  8714    W !,"Trac e Number      : ",$$G ET1^DIQ(34 4.4,RCERA, .02,"E")
  8715   "RTN","RCD PEM5",402, 0)
  8716    W !,"Tota l Amount P aid: ",$$G ET1^DIQ(36 1.1,RCEEOB ,1.01,"E")
  8717   "RTN","RCD PEM5",403, 0)
  8718    W !,"Date /Time Remo ved: ",$$G ET1^DIQ(36 1.1101,RCE EOBH_","_R CEEOB,.01, "E")
  8719   "RTN","RCD PEM5",404, 0)
  8720    W !,"Remo ved by        : ",$$G ET1^DIQ(36 1.1101,RCE EOBH_","_R CEEOB,.02, "E")
  8721   "RTN","RCD PEM5",405, 0)
  8722    W !,"Just ification     : ",$$G ET1^DIQ(36 1.1101,RCE EOBH_","_R CEEOB,.03, "E"),!
  8723   "RTN","RCD PEM5",406, 0)
  8724    ;
  8725   "RTN","RCD PEM5",407, 0)
  8726    ; Confirm  that this  is the co rrect EEOB
  8727   "RTN","RCD PEM5",408, 0)
  8728    K DIR
  8729   "RTN","RCD PEM5",409, 0)
  8730    S DIR(0)= "YO",DIR(" B")="NO"
  8731   "RTN","RCD PEM5",410, 0)
  8732    S DIR("A" )="Is this  the corre ct EEOB to  associate  with this  claim"
  8733   "RTN","RCD PEM5",411, 0)
  8734    D ^DIR
  8735   "RTN","RCD PEM5",412, 0)
  8736    I $G(DTOU T)!($G(DUO UT)) Q -1
  8737   "RTN","RCD PEM5",413, 0)
  8738    Q:Y'=1 0
  8739   "RTN","RCD PEM5",414, 0)
  8740    ;
  8741   "RTN","RCD PEM5",415, 0)
  8742    ;Return s elected EE OB
  8743   "RTN","RCD PEM5",416, 0)
  8744    Q RCEEOB
  8745   "RTN","RCD PEM5",417, 0)
  8746    ;
  8747   "RTN","RCD PEM5",418, 0)
  8748   SUSP(RCRCP T,RCTRANDA ,RCERA,RCL INE) ; Ide ntify susp ended EEOB
  8749   "RTN","RCD PEM5",419, 0)
  8750    ;
  8751   "RTN","RCD PEM5",420, 0)
  8752    ; INPUT -  RCRCPT -  Receipt ie n #344
  8753   "RTN","RCD PEM5",421, 0)
  8754    ;       -  RCTRANDA  - Receipt  line #344. 01
  8755   "RTN","RCD PEM5",422, 0)
  8756    ;
  8757   "RTN","RCD PEM5",423, 0)
  8758    ; OUTPUT  - RCEEOB -  selected  EEOB ien # 361.1 
  8759   "RTN","RCD PEM5",424, 0)
  8760    ;         - RCERA -  ERA ien #3 44.4
  8761   "RTN","RCD PEM5",425, 0)
  8762    ;         - RCLINE -  ERA line  #344.41;
  8763   "RTN","RCD PEM5",426, 0)
  8764    ;
  8765   "RTN","RCD PEM5",427, 0)
  8766    N RCEEOB, RCORIG,RCR CZ,RCSPLIT
  8767   "RTN","RCD PEM5",428, 0)
  8768    ; Get ERA  from rece ipt
  8769   "RTN","RCD PEM5",429, 0)
  8770    S RCERA=$ $GET1^DIQ( 344,RCRCPT _",",.18," I")
  8771   "RTN","RCD PEM5",430, 0)
  8772    ; Quit if  no ERA
  8773   "RTN","RCD PEM5",431, 0)
  8774    Q:'RCERA  0
  8775   "RTN","RCD PEM5",432, 0)
  8776    ; Get ERA  Scratchpa d line
  8777   "RTN","RCD PEM5",433, 0)
  8778    S RCRCZ=$ $GET1^DIQ( 344.01,RCT RANDA_","_ RCRCPT_"," ,.27,"I")
  8779   "RTN","RCD PEM5",434, 0)
  8780    ; Quit if  ERA scrat chpad line  missing
  8781   "RTN","RCD PEM5",435, 0)
  8782    Q:'RCRCZ  0
  8783   "RTN","RCD PEM5",436, 0)
  8784    ; Get the  original  line seque nce number  from befo re the spl it was per formed
  8785   "RTN","RCD PEM5",437, 0)
  8786    S RCSPLIT =$$GET1^DI Q(344.491, RCRCZ_","_ RCERA_",", .01),RCORI G=RCSPLIT\ 1
  8787   "RTN","RCD PEM5",438, 0)
  8788    ; Convert  sequence  number int o original  line IEN
  8789   "RTN","RCD PEM5",439, 0)
  8790    S RCORIG= $O(^RCY(34 4.49,RCERA ,1,"ASEQ", RCORIG,"") )
  8791   "RTN","RCD PEM5",440, 0)
  8792    ; Quit if  original  scratchpad  line not  found
  8793   "RTN","RCD PEM5",441, 0)
  8794    Q:'RCORIG  0
  8795   "RTN","RCD PEM5",442, 0)
  8796    ; Get ERA  line from  original  scratchpad  line
  8797   "RTN","RCD PEM5",443, 0)
  8798    S RCLINE= $$GET1^DIQ (344.491,R CORIG_","_ RCERA_",", .09,"I")
  8799   "RTN","RCD PEM5",444, 0)
  8800    ; Quit if  ERA line  not found
  8801   "RTN","RCD PEM5",445, 0)
  8802    Q:'RCLINE  0
  8803   "RTN","RCD PEM5",446, 0)
  8804    ; Get EEO B from ERA  line
  8805   "RTN","RCD PEM5",447, 0)
  8806    S RCEEOB= $$GET1^DIQ (344.41,RC LINE_","_R CERA_",",. 02,"I")
  8807   "RTN","RCD PEM5",448, 0)
  8808    ; Quit if  ERA line  pointer to  EEOB is m issing
  8809   "RTN","RCD PEM5",449, 0)
  8810    Q:'RCEEOB  0
  8811   "RTN","RCD PEM5",450, 0)
  8812    ; Ignore  EEOB if st atus is no t removed  - read acc ess to fil e #361.1 u nder IA 40 51
  8813   "RTN","RCD PEM5",451, 0)
  8814    Q:$$GET1^ DIQ(361.1, RCEEOB_"," ,102,"I")' =1 0
  8815   "RTN","RCD PEM5",452, 0)
  8816    ; Return  suspended  EEOB IEN
  8817   "RTN","RCD PEM5",453, 0)
  8818    Q RCEEOB
  8819   "RTN","RCD PEM5",454, 0)
  8820    ;
  8821   "RTN","RCD PEM5",455, 0)
  8822    ; EP RCDP RPL1 and R CDPLPL3
  8823   "RTN","RCD PEM5",456, 0)
  8824   RESTORE(RC PTDA,RCTRA NDA,ORIG,S RC) ; Chan ge bill nu mber on EO B and clea r 'removed ' status
  8825   "RTN","RCD PEM5",457, 0)
  8826    ;
  8827   "RTN","RCD PEM5",458, 0)
  8828    ; INPUT -  RCPTDA    - Receipt  ien #344
  8829   "RTN","RCD PEM5",459, 0)
  8830    ;       -  RCTRANDA  - Receipt  line #344. 01
  8831   "RTN","RCD PEM5",460, 0)
  8832    ;       -  ORIG      - EOB ien  #361.1
  8833   "RTN","RCD PEM5",461, 0)
  8834    ;       -  SRC       - 'L' - Li nk Payment s 'R' - Re ceipt Porc essing
  8835   "RTN","RCD PEM5",462, 0)
  8836    ;
  8837   "RTN","RCD PEM5",463, 0)
  8838    Q:'$$LOCK ^IBCEOB4(O RIG)
  8839   "RTN","RCD PEM5",464, 0)
  8840    ;
  8841   "RTN","RCD PEM5",465, 0)
  8842    W !,"Upda ting EEOB. ..."
  8843   "RTN","RCD PEM5",466, 0)
  8844    ;
  8845   "RTN","RCD PEM5",467, 0)
  8846    N NCLAIM, JUST
  8847   "RTN","RCD PEM5",468, 0)
  8848    ; Get new  claim IEN  from rece ipt line
  8849   "RTN","RCD PEM5",469, 0)
  8850    S NCLAIM= $P($$GET1^ DIQ(344.01 ,RCTRANDA_ ","_RCPTDA _",",.09," I"),";")
  8851   "RTN","RCD PEM5",470, 0)
  8852    ; Set up  justificat ion text
  8853   "RTN","RCD PEM5",471, 0)
  8854    S JUST="E EOB restor ed from su spense in  "_$S(SRC=" L":"Link P ayments",S RC="R":"Ed it Payment s",1:"Othe r")
  8855   "RTN","RCD PEM5",472, 0)
  8856    ; Update  AR comment s on 'from  claim'
  8857   "RTN","RCD PEM5",473, 0)
  8858    D AUDIT^R CDPAYER(OR IG,JUST,"W ")
  8859   "RTN","RCD PEM5",474, 0)
  8860    ; Change  claim numb er on EOB
  8861   "RTN","RCD PEM5",475, 0)
  8862    D MOVE^IB CEOB4(ORIG ,NCLAIM,DU Z,$$NOW^XL FDT,JUST," M")
  8863   "RTN","RCD PEM5",476, 0)
  8864    ; Reset E EOB REMOVE D status
  8865   "RTN","RCD PEM5",477, 0)
  8866    D RESTORE ^IBCEOB4(O RIG)
  8867   "RTN","RCD PEM5",478, 0)
  8868    ;Unlock E OB
  8869   "RTN","RCD PEM5",479, 0)
  8870    D UNLOCK^ IBCEOB4(OR IG)
  8871   "RTN","RCD PEM5",480, 0)
  8872    ;
  8873   "RTN","RCD PEM5",481, 0)
  8874    H 1 W "do ne"
  8875   "RTN","RCD PEM5",482, 0)
  8876    Q
  8877   "RTN","RCD PEM9")
  8878   0^30^B8191 9705
  8879   "RTN","RCD PEM9",1,0)
  8880   RCDPEM9 ;O I D N
S           /PJH - PAY ER SELECTI ON ;10/18/ 11 6:17pm
  8881   "RTN","RCD PEM9",2,0)
  8882    ;;4.5;Acc ounts Rece ivable;**2 76,284,318 ,326,332** ;Mar 20, 1 995;Build  34
  8883   "RTN","RCD PEM9",3,0)
  8884    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  8885   "RTN","RCD PEM9",4,0)
  8886    ;
  8887   "RTN","RCD PEM9",5,0)
  8888    ; PRCA*4. 5*318 - Ad ded parame ters MIXED  and BLANK LN
  8889   "RTN","RCD PEM9",6,0)
  8890    ; PRCA*4. 5*326 - Ex tensive re write to i nclude sel ection/sor t by payer  TIN in th e Auto Pos t Report
  8891   "RTN","RCD PEM9",7,0)
  8892   GETPAY(FIL E,MIXED,BL ANKLN,NMOR TIN,SHOWTI N) ; Let u ser select  payer for  filter
  8893   "RTN","RCD PEM9",8,0)
  8894    ; Input:    FILE     - File to  retrieve P ayers from  either #3 44.4 OR ## 344.31
  8895   "RTN","RCD PEM9",9,0)
  8896    ;           MIXED    - 1 to dis play promp ts in mixe d case
  8897   "RTN","RCD PEM9",10,0 )
  8898    ;                      Optional , defaults  to 0
  8899   "RTN","RCD PEM9",11,0 )
  8900    ;           BLANKLN  - 0 skip i nitial bla nk line
  8901   "RTN","RCD PEM9",12,0 )
  8902    ;                      Optional , defaults  to 1
  8903   "RTN","RCD PEM9",13,0 )
  8904    ;           NMORTIN  - 1 to loo k-up Payer  by Payer  Name, 2 to  look-up b y TIN
  8905   "RTN","RCD PEM9",14,0 )
  8906    ;                      0 or und efined - p re-326 beh avior, loo k-up by pa yer name a nd don't i nclude TIN  in output  array.
  8907   "RTN","RCD PEM9",15,0 )
  8908    ;                      Optional , defaults  to 0
  8909   "RTN","RCD PEM9",16,0 )
  8910    ;           SHOWTIN  - 1 to app end the Pa yer Name o r Payer TI N when dis playing pa yers
  8911   "RTN","RCD PEM9",17,0 )
  8912    ;                      Optional , defaults  to 0
  8913   "RTN","RCD PEM9",18,0 )
  8914    ; Output:   ^TMP("RC SELPAY",$J ) - Array  of selecte d Payers
  8915   "RTN","RCD PEM9",19,0 )
  8916    ; Returns : A1^A2^A3  Where:
  8917   "RTN","RCD PEM9",20,0 )
  8918    ;            A1 - -1  - None se lected
  8919   "RTN","RCD PEM9",21,0 )
  8920    ;                  1  - Range o f payers
  8921   "RTN","RCD PEM9",22,0 )
  8922    ;                  2  - All pay ers select ed
  8923   "RTN","RCD PEM9",23,0 )
  8924    ;                  3  - Specifi c payers
  8925   "RTN","RCD PEM9",24,0 )
  8926    ;            A2 - Fr om Range ( When a fro m/thru ran ge is sele cted by us er)
  8927   "RTN","RCD PEM9",25,0 )
  8928    ;            A3 - Th ru Range ( When a fro m/thru ran ge is sele cted by us er)
  8929   "RTN","RCD PEM9",26,0 )
  8930    N CNT,DIR ,DIROUT,DI RUT,DTOUT, DUOUT,I,IE N,INDX
  8931   "RTN","RCD PEM9",27,0 )
  8932    N RCANS,R CANS2,RCIN C,RCINSF,R CINST,RCPA Y,RNG1,RNG 2,RTNFLG,T IN,X,XX,Y
  8933   "RTN","RCD PEM9",28,0 )
  8934    S:'$D(MIX ED) MIXED= 0   ; PRCA *4.5*318 -  Added log ic for MIX ED and BLA NKLN
  8935   "RTN","RCD PEM9",29,0 )
  8936    S:'$D(BLA NKLN) BLAN KLN=1
  8937   "RTN","RCD PEM9",30,0 )
  8938    S:'$D(NMO RTIN) NMOR TIN=0
  8939   "RTN","RCD PEM9",31,0 )
  8940    S:'$D(SHO WTIN) SHOW TIN=0
  8941   "RTN","RCD PEM9",32,0 )
  8942    ;
  8943   "RTN","RCD PEM9",33,0 )
  8944    S RTNFLG= 0,INDX=1,R NG1="",RNG 2=""
  8945   "RTN","RCD PEM9",34,0 )
  8946    K ^TMP("R CSELPAY",$ J)                        ; Clea r list of  selected P ayers
  8947   "RTN","RCD PEM9",35,0 )
  8948    ;
  8949   "RTN","RCD PEM9",36,0 )
  8950    ; Select  option req uired (All , Selected  or Range)
  8951   "RTN","RCD PEM9",37,0 )
  8952    I NMORTIN =2 D
  8953   "RTN","RCD PEM9",38,0 )
  8954    . S DIR(0 )="SA^A:AL L;S:SPECIF IC"
  8955   "RTN","RCD PEM9",39,0 )
  8956    . S:MIXED  DIR("A")= "Run Repor t for (A)L L or (S)PE CIFIC Insu rance Comp anies?: "
  8957   "RTN","RCD PEM9",40,0 )
  8958    . S:'MIXE D DIR("A") ="RUN REPO RT FOR (A) LL OR (S)P ECIFIC INS URANCE COM PANIES?: "
  8959   "RTN","RCD PEM9",41,0 )
  8960    E  D
  8961   "RTN","RCD PEM9",42,0 )
  8962    . S DIR(0 )="SA^A:AL L;S:SPECIF IC;R:RANGE "
  8963   "RTN","RCD PEM9",43,0 )
  8964    . S:MIXED  DIR("A")= "Run Repor t for (A)L L, (S)PECI FIC, or (R )ANGE of I nsurance C ompanies?:  "
  8965   "RTN","RCD PEM9",44,0 )
  8966    . S:'MIXE D DIR("A") ="RUN REPO RT FOR (A) LL, (S)PEC IFIC, OR ( R)ANGE OF  INSURANCE  COMPANIES? : "
  8967   "RTN","RCD PEM9",45,0 )
  8968    . S DIR(" ?",2)="Ent er 'RANGE'  to select  an Insura nce Compan y range."
  8969   "RTN","RCD PEM9",46,0 )
  8970    S DIR("B" )="ALL"
  8971   "RTN","RCD PEM9",47,0 )
  8972    S DIR("?" ,1)="Enter  'ALL' to  select all  Insurance  Companies ."
  8973   "RTN","RCD PEM9",48,0 )
  8974    S DIR("?" )="Enter ' SPECIFIC'  to select  specific I nsurance C ompanies."
  8975   "RTN","RCD PEM9",49,0 )
  8976    W:BLANKLN  !          ; PRCA*4. 5*318 - Ad ded condit ion for BL ANKLN
  8977   "RTN","RCD PEM9",50,0 )
  8978    D ^DIR K  DIR
  8979   "RTN","RCD PEM9",51,0 )
  8980    ;
  8981   "RTN","RCD PEM9",52,0 )
  8982    ; Abort o n ^ exit o r timeout
  8983   "RTN","RCD PEM9",53,0 )
  8984    I $D(DTOU T)!$D(DUOU T) S RTNFL G=-1 Q RTN FLG
  8985   "RTN","RCD PEM9",54,0 )
  8986    ;
  8987   "RTN","RCD PEM9",55,0 )
  8988    ; ALL pay ers 
  8989   "RTN","RCD PEM9",56,0 )
  8990    ; Switch  to use new  Payer Nam e/Payer TI N index
  8991   "RTN","RCD PEM9",57,0 )
  8992    I Y="A" D
  8993   "RTN","RCD PEM9",58,0 )
  8994    . S CNT=0 ,RCPAY="", RTNFLG=2
  8995   "RTN","RCD PEM9",59,0 )
  8996    . F  S RC PAY=$O(^RC Y(FILE,"C" ,RCPAY)) Q :RCPAY=""   D
  8997   "RTN","RCD PEM9",60,0 )
  8998    . . S CNT =CNT+1,IEN =$O(^RCY(F ILE,"C",RC PAY,""))
  8999   "RTN","RCD PEM9",61,0 )
  9000    . . S TIN =$$GET1^DI Q(FILE,IEN ,.03,"E")
  9001   "RTN","RCD PEM9",62,0 )
  9002    . . S XX= $S(NMORTIN =2:TIN_"/" _RCPAY,NMO RTIN=1:RCP AY_"/"_TIN ,1:RCPAY)
  9003   "RTN","RCD PEM9",63,0 )
  9004    . . S ^TM P("RCSELPA Y",$J,CNT) =XX
  9005   "RTN","RCD PEM9",64,0 )
  9006    ;
  9007   "RTN","RCD PEM9",65,0 )
  9008    ; Selecte d Payers
  9009   "RTN","RCD PEM9",66,0 )
  9010    I Y="S" D
  9011   "RTN","RCD PEM9",67,0 )
  9012    . D GLIST (FILE,NMOR TIN),GETPA YS(CNT,MIX ED,NMORTIN )  ; PRCA* 4.5*318 -  Added para meter MIXE D
  9013   "RTN","RCD PEM9",68,0 )
  9014    ;
  9015   "RTN","RCD PEM9",69,0 )
  9016    ; Range o f Payers
  9017   "RTN","RCD PEM9",70,0 )
  9018    I Y="R" D
  9019   "RTN","RCD PEM9",71,0 )
  9020    . D GLIST (FILE,NMOR TIN),GETPA YR(MIXED,B LANKLN)  ;  PRCA*4.5* 318 - Adde d paramete rs MIXED a nd BLANKLN
  9021   "RTN","RCD PEM9",72,0 )
  9022    ;
  9023   "RTN","RCD PEM9",73,0 )
  9024    K:RTNFLG' =2 ^TMP("R CPAYER",$J )              ; Clea r list of  all payers
  9025   "RTN","RCD PEM9",74,0 )
  9026    K:RTNFLG= -1 ^TMP("R CSELPAY",$ J)             ; Abor ting, clea r any sele cted payer s
  9027   "RTN","RCD PEM9",75,0 )
  9028    ;
  9029   "RTN","RCD PEM9",76,0 )
  9030    ; PRCA*4. 5*284 - Up date retur n value to  include f rom/thru r ange. See  above for  documentat ion
  9031   "RTN","RCD PEM9",77,0 )
  9032    Q RTNFLG_ "^"_RNG1_" ^"_RNG2                   ; Retu rn value
  9033   "RTN","RCD PEM9",78,0 )
  9034    ;
  9035   "RTN","RCD PEM9",79,0 )
  9036   GLIST(FILE ,NMORTIN)  ; Build li st for thi s file
  9037   "RTN","RCD PEM9",80,0 )
  9038    ; Input:    FILE     - File to  retrieve P ayers from  either #3 44.4 OR ## 344.31
  9039   "RTN","RCD PEM9",81,0 )
  9040    ;           NMORTIN  - 2 - look up by TIN,  1 - looku p by Payer  Name, 0 -  pre 326 b ehavior
  9041   "RTN","RCD PEM9",82,0 )
  9042    ; Output:   ^TMP("RC PAYER",$J, A1)=A2 Whe re:
  9043   "RTN","RCD PEM9",83,0 )
  9044    ;                      A1 - Cou nter
  9045   "RTN","RCD PEM9",84,0 )
  9046    ;                      A2 - Pay er Name/TI N if NMORT IN=1, TIN/ Payer Name  if NMORTI N=2, else  Payer Name  
  9047   "RTN","RCD PEM9",85,0 )
  9048    ;           ^TMP("RC PAYER",$J, "B",B1,B2) =B3 Where:
  9049   "RTN","RCD PEM9",86,0 )
  9050    ;                      B1 - Pay er TIN if  NMORTIN=2,  else Paye r Name
  9051   "RTN","RCD PEM9",87,0 )
  9052    ;                      B2 - Cou nter
  9053   "RTN","RCD PEM9",88,0 )
  9054    ;                      B3 - Pay er Name if  NMORTIN=0  or 1, els e Payer TI N
  9055   "RTN","RCD PEM9",89,0 )
  9056    N IEN,PAY NAM,TIN
  9057   "RTN","RCD PEM9",90,0 )
  9058    K ^TMP("R CPAYER",$J )                         ; Clea r workfile
  9059   "RTN","RCD PEM9",91,0 )
  9060    I NMORTIN =2 D  Q                              ; Buil d list of  Payers by  TIN
  9061   "RTN","RCD PEM9",92,0 )
  9062    . S CNT=0 ,TIN=""
  9063   "RTN","RCD PEM9",93,0 )
  9064    . F  S TI N=$O(^RCY( FILE,"ATP" ,TIN)) Q:T IN=""  D
  9065   "RTN","RCD PEM9",94,0 )
  9066    . . S PAY NAM=""
  9067   "RTN","RCD PEM9",95,0 )
  9068    . . F  S  PAYNAM=$O( ^RCY(FILE, "ATP",TIN, PAYNAM)) Q :PAYNAM=""   D
  9069   "RTN","RCD PEM9",96,0 )
  9070    . . . S C NT=CNT+1
  9071   "RTN","RCD PEM9",97,0 )
  9072    . . . S ^ TMP("RCPAY ER",$J,CNT )=TIN_"/"_ PAYNAM
  9073   "RTN","RCD PEM9",98,0 )
  9074    . . . S ^ TMP("RCPAY ER",$J,"B" ,TIN,CNT)= PAYNAM
  9075   "RTN","RCD PEM9",99,0 )
  9076    ;
  9077   "RTN","RCD PEM9",100, 0)
  9078    S CNT=0,P AYNAM=""
  9079   "RTN","RCD PEM9",101, 0)
  9080    F  S PAYN AM=$O(^RCY (FILE,"APT ",PAYNAM))  Q:PAYNAM= ""  D
  9081   "RTN","RCD PEM9",102, 0)
  9082    . S TIN=" "
  9083   "RTN","RCD PEM9",103, 0)
  9084    . F  S TI N=$O(^RCY( FILE,"APT" ,PAYNAM,TI N)) Q:TIN= ""  D
  9085   "RTN","RCD PEM9",104, 0)
  9086    . . S CNT =CNT+1
  9087   "RTN","RCD PEM9",105, 0)
  9088    . . S ^TM P("RCPAYER ",$J,CNT)= $S(NMORTIN =1:PAYNAM_ "/"_TIN,1: PAYNAM)
  9089   "RTN","RCD PEM9",106, 0)
  9090    . . S ^TM P("RCPAYER ",$J,"B",P AYNAM,CNT) =TIN
  9091   "RTN","RCD PEM9",107, 0)
  9092    Q
  9093   "RTN","RCD PEM9",108, 0)
  9094    ;
  9095   "RTN","RCD PEM9",109, 0)
  9096    ; PRCA*4. 5*318 - Ad ded parame ter & logi c for MIXE D
  9097   "RTN","RCD PEM9",110, 0)
  9098   GETPAYS(CN T,MIXED,NM ORTIN) ; S elect Spec ific payer  for filte r
  9099   "RTN","RCD PEM9",111, 0)
  9100    ; Input:    CNT      - Number o f Payers
  9101   "RTN","RCD PEM9",112, 0)
  9102    ;           MIXED    - 1 to dis play promp ts in mixe d case
  9103   "RTN","RCD PEM9",113, 0)
  9104    ;                      Optional , defaults  to 0
  9105   "RTN","RCD PEM9",114, 0)
  9106    ;           NMORTIN  - 2 to loo kup by TIN , 1 to loo kup by Pay er, 0 - Pr e 326 beha vior
  9107   "RTN","RCD PEM9",115, 0)
  9108    ;                      Optional , defaults  to 0
  9109   "RTN","RCD PEM9",116, 0)
  9110    ; Output:  RTNFLG -1  - No Paye r selected
  9111   "RTN","RCD PEM9",117, 0)
  9112    ;                  3  - At leas t one Paye r selected
  9113   "RTN","RCD PEM9",118, 0)
  9114    S:'$D(MIX ED) MIXED= 0
  9115   "RTN","RCD PEM9",119, 0)
  9116    S:'$D(NMO RTIN) NMOR TIN=0
  9117   "RTN","RCD PEM9",120, 0)
  9118    K ^TMP("R CDPEM9",$J )
  9119   "RTN","RCD PEM9",121, 0)
  9120    F  Q:RTNF LG'=0  D
  9121   "RTN","RCD PEM9",122, 0)
  9122    . N DIR,D IROUT,DIRU T,DTOUT,DU OUT,X,Y
  9123   "RTN","RCD PEM9",123, 0)
  9124    . S DIR(" A")="SELEC T INSURANC E COMPANY"
  9125   "RTN","RCD PEM9",124, 0)
  9126    . S:MIXED  DIR("A")= "Select In surance Co mpany "_$S (NMORTIN=2 :"TIN",1:" NAME")   ;  PRCA*4.5* 318
  9127   "RTN","RCD PEM9",125, 0)
  9128    . S DIR(0 )="FO^1:30 "
  9129   "RTN","RCD PEM9",126, 0)
  9130    . S DIR(" ?")="ENTER  THE "_$S( NMORTIN=2: "TIN",1:"N AME")_" OF  THE PAYER  OR '??' T O LIST PAY ERS"
  9131   "RTN","RCD PEM9",127, 0)
  9132    . ; PRCA* 4.5*318 -  Added MIXE D
  9133   "RTN","RCD PEM9",128, 0)
  9134    . S:MIXED  DIR("?")= "Enter the  "_$S(NMOR TIN=2:"TIN ",1:"name" )_" of the  payer or  '??' to li st payers"
  9135   "RTN","RCD PEM9",129, 0)
  9136    . S DIR(" ??")="^D L IST^RCDPEM 9(CNT)"
  9137   "RTN","RCD PEM9",130, 0)
  9138    . D ^DIR  K DIR
  9139   "RTN","RCD PEM9",131, 0)
  9140    . ;
  9141   "RTN","RCD PEM9",132, 0)
  9142    . ; User  pressed EN TER
  9143   "RTN","RCD PEM9",133, 0)
  9144    . I Y="", '$D(DTOUT)  S RTNFLG= $S($D(^TMP ("RCSELPAY ",$J)):3,1 :-1) Q
  9145   "RTN","RCD PEM9",134, 0)
  9146    . ;
  9147   "RTN","RCD PEM9",135, 0)
  9148    . ; First  check for  exits
  9149   "RTN","RCD PEM9",136, 0)
  9150    . I $D(DU OUT)!$D(DT OUT)!$D(DI RUT)!$D(DI ROUT) S RT NFLG=-1 Q
  9151   "RTN","RCD PEM9",137, 0)
  9152    . S (RCAN S,RCANS2)= "",RCANS=Y
  9153   "RTN","RCD PEM9",138, 0)
  9154    . I NMORT IN=2 D  Q                                   ; TIN look up
  9155   "RTN","RCD PEM9",139, 0)
  9156    . . I '$D (^TMP("RCP AYER",$J," B",RCANS))  D  Q
  9157   "RTN","RCD PEM9",140, 0)
  9158    . . . W "   ??"
  9159   "RTN","RCD PEM9",141, 0)
  9160    . . I $D( ^TMP("RCDP EM9",$J,RC ANS)) D  Q
  9161   "RTN","RCD PEM9",142, 0)
  9162    . . . W:' MIXED "  ? ? PAYER AL READY SELE CTED"
  9163   "RTN","RCD PEM9",143, 0)
  9164    . . . W:M IXED "  ??  Payer alr eady selec ted"
  9165   "RTN","RCD PEM9",144, 0)
  9166    . . D SEL TIN(RCANS, .INDX)
  9167   "RTN","RCD PEM9",145, 0)
  9168    . ;
  9169   "RTN","RCD PEM9",146, 0)
  9170    . ; Check  for Parti al Match o n user inp ut
  9171   "RTN","RCD PEM9",147, 0)
  9172    . I '(RCA NS?.N) D    Q:'$G(RCA NS2)
  9173   "RTN","RCD PEM9",148, 0)
  9174    . . S RCA NS2=$O(^TM P("RCPAYER ",$J,"B",R CANS,RCANS 2))
  9175   "RTN","RCD PEM9",149, 0)
  9176    . . D:'RC ANS2 PART( NMORTIN,RC ANS,.INDX)
  9177   "RTN","RCD PEM9",150, 0)
  9178    . S:$G(RC ANS2) RCAN S=RCANS2
  9179   "RTN","RCD PEM9",151, 0)
  9180    . I RCANS ="" W "  ? ?" Q
  9181   "RTN","RCD PEM9",152, 0)
  9182    . I RCANS ?.N,((+RCA NS<1)!(+RC ANS>CNT))  W "  ??" Q
  9183   "RTN","RCD PEM9",153, 0)
  9184    . I RCANS '?.N W "   ??" Q
  9185   "RTN","RCD PEM9",154, 0)
  9186    . I $D(^T MP("RCDPEM 9",$J,RCAN S)) D  Q
  9187   "RTN","RCD PEM9",155, 0)
  9188    . . W:'MI XED "  ??  PAYER ALRE ADY SELECT ED"
  9189   "RTN","RCD PEM9",156, 0)
  9190    . . W:MIX ED "  ?? P ayer alrea dy selecte d"
  9191   "RTN","RCD PEM9",157, 0)
  9192    . S ^TMP( "RCDPEM9", $J,RCANS)= ""
  9193   "RTN","RCD PEM9",158, 0)
  9194    . W "  ", ^TMP("RCPA YER",$J,RC ANS)
  9195   "RTN","RCD PEM9",159, 0)
  9196    . S ^TMP( "RCSELPAY" ,$J,INDX)= $G(^TMP("R CPAYER",$J ,RCANS))
  9197   "RTN","RCD PEM9",160, 0)
  9198    . S INDX= INDX+1
  9199   "RTN","RCD PEM9",161, 0)
  9200    K ^TMP("R CDPEM9",$J )
  9201   "RTN","RCD PEM9",162, 0)
  9202    Q
  9203   "RTN","RCD PEM9",163, 0)
  9204    ;
  9205   "RTN","RCD PEM9",164, 0)
  9206   SELTIN(TIN ,INDX) ; S how all th e payers w ith the se lected TIN  and ask t he user
  9207   "RTN","RCD PEM9",165, 0)
  9208    ; if they  want to s elect the  TIN
  9209   "RTN","RCD PEM9",166, 0)
  9210    ; Input:    TIN                       - Us er Selecte d TIN
  9211   "RTN","RCD PEM9",167, 0)
  9212    ;           INDX                      - Cu rrent # of  selected  Payers
  9213   "RTN","RCD PEM9",168, 0)
  9214    ;           ^TMP("RC PAYER",$J, "B")  - Ar ray of TIN s on file
  9215   "RTN","RCD PEM9",169, 0)
  9216    ;           ^TMP("RC SELPAY",$J ,A1)= A2/A 3  Current  Selected  Payers Whe re:
  9217   "RTN","RCD PEM9",170, 0)
  9218    ;                               A1 - Count er
  9219   "RTN","RCD PEM9",171, 0)
  9220    ;                               A2 - Selec ted TIN
  9221   "RTN","RCD PEM9",172, 0)
  9222    ;                               A3 - Selec ted PAYER
  9223   "RTN","RCD PEM9",173, 0)
  9224    ; Output:   INDX                      - Up dated # of  selected  Payers                       
  9225   "RTN","RCD PEM9",174, 0)
  9226    ;           ^TMP("RC SELPAY",$J ,A1)= A2/A 3  Updated  Selected  Payers Whe re:
  9227   "RTN","RCD PEM9",175, 0)
  9228    ;                               A1 - Count er
  9229   "RTN","RCD PEM9",176, 0)
  9230    ;                               A2 - Selec ted TIN
  9231   "RTN","RCD PEM9",177, 0)
  9232    ;                               A3 - Selec ted PAYER
  9233   "RTN","RCD PEM9",178, 0)
  9234    N CTR,DIR ,DIROUT,DI RUT,DTOUT, DUOUT,SELP AY,X,Y
  9235   "RTN","RCD PEM9",179, 0)
  9236    W !,"The  following  Payers wit h TIN ",TI N," have E RAs on fil e"
  9237   "RTN","RCD PEM9",180, 0)
  9238    D PART(2, TIN,INDX,. SELPAY)
  9239   "RTN","RCD PEM9",181, 0)
  9240    S DIR(0)= "Y"
  9241   "RTN","RCD PEM9",182, 0)
  9242    S DIR("A" )="Select  this TIN"
  9243   "RTN","RCD PEM9",183, 0)
  9244    S DIR("B" )="YES"
  9245   "RTN","RCD PEM9",184, 0)
  9246    D ^DIR
  9247   "RTN","RCD PEM9",185, 0)
  9248    Q:$D(DTOU T)!$D(DUOU T)
  9249   "RTN","RCD PEM9",186, 0)
  9250    Q:Y=0
  9251   "RTN","RCD PEM9",187, 0)
  9252    M ^TMP("R CSELPAY",$ J)=SELPAY( "RCSELPAY" )
  9253   "RTN","RCD PEM9",188, 0)
  9254    S INDX=$O (SELPAY("R CSELPAY"," "),-1)+1
  9255   "RTN","RCD PEM9",189, 0)
  9256    Q
  9257   "RTN","RCD PEM9",190, 0)
  9258    ;
  9259   "RTN","RCD PEM9",191, 0)
  9260   LIST(CNT)  ; Display  all the Pa yers
  9261   "RTN","RCD PEM9",192, 0)
  9262    ; Prompt  users for  stations t o be used  for filter ing
  9263   "RTN","RCD PEM9",193, 0)
  9264    ; Input:    CNT - To tal # of P ayers in t mp file
  9265   "RTN","RCD PEM9",194, 0)
  9266    ;           ^TMP("RC PAYER",$J, A1)=A2 Whe re:
  9267   "RTN","RCD PEM9",195, 0)
  9268    ;                      A1 - Cou nter
  9269   "RTN","RCD PEM9",196, 0)
  9270    ;                      A2 - Pay er Name/TI N if NMORT IN=1, TIN/ Payer Name  if NMORTI N=2, else  Payer Name
  9271   "RTN","RCD PEM9",197, 0)
  9272    N I
  9273   "RTN","RCD PEM9",198, 0)
  9274    F I=1:1:C NT D
  9275   "RTN","RCD PEM9",199, 0)
  9276    . W !,I," .",?5,$G(^ TMP("RCPAY ER",$J,I))
  9277   "RTN","RCD PEM9",200, 0)
  9278    Q
  9279   "RTN","RCD PEM9",201, 0)
  9280    ;
  9281   "RTN","RCD PEM9",202, 0)
  9282   PART(NMORT IN,RCANS,I NDX,SELPAY ) ; Give t he user a  list of pa rtial matc hes
  9283   "RTN","RCD PEM9",203, 0)
  9284    ; Input:    NMORTIN  - 2 - Look up by Paye r TIN, 0 o r 1 - Look up by Paye r Name
  9285   "RTN","RCD PEM9",204, 0)
  9286    ;           RCANS    - User Pay er or TIN  selection
  9287   "RTN","RCD PEM9",205, 0)
  9288    ;           INDX     - Current  # of selec ted Payers  (only pas sed if NMO RTIN=2)
  9289   "RTN","RCD PEM9",206, 0)
  9290    ; Output:   SELPAY() - Array of  selected  Payers (on ly returne d if NMORT IN=2)
  9291   "RTN","RCD PEM9",207, 0)
  9292    ;           ^TMP("RC PAYER",$J, A1)=A2 Whe re:
  9293   "RTN","RCD PEM9",208, 0)
  9294    ;                      A1 - Cou nter
  9295   "RTN","RCD PEM9",209, 0)
  9296    ;                      A2 - Pay er Name/TI N if NMORT IN=1, TIN/ Payer Name  if NMORTI N=2, else  Payer Name
  9297   "RTN","RCD PEM9",210, 0)
  9298    ;           ^TMP("RC PAYER",$J, "B",B1,B2) =B3 Where:
  9299   "RTN","RCD PEM9",211, 0)
  9300    ;                      B1 - Pay er TIN if  NMORTIN=0,  else Paye r Name
  9301   "RTN","RCD PEM9",212, 0)
  9302    ;                      B2 - Cou nter
  9303   "RTN","RCD PEM9",213, 0)
  9304    ;                      B3 - Pay er Name if  NMORTIN=0  or 1, els e Payer TI N
  9305   "RTN","RCD PEM9",214, 0)
  9306    ; Output:   List of  Payers tha t meet the  partial m atch
  9307   "RTN","RCD PEM9",215, 0)
  9308    N RCPAR,C NT,CTR,RCS AVE
  9309   "RTN","RCD PEM9",216, 0)
  9310    S CNT=0,R CPAR=RCANS ,RCPAR=$O( ^TMP("RCPA YER",$J,"B ",RCPAR),- 1)
  9311   "RTN","RCD PEM9",217, 0)
  9312    F  D  Q:R CPAR=""
  9313   "RTN","RCD PEM9",218, 0)
  9314    . S RCPAR =$O(^TMP(" RCPAYER",$ J,"B",RCPA R))
  9315   "RTN","RCD PEM9",219, 0)
  9316    . Q:RCPAR =""
  9317   "RTN","RCD PEM9",220, 0)
  9318    . I $E(RC PAR,1,$L(R CANS))'[RC ANS S RCPA R="" Q
  9319   "RTN","RCD PEM9",221, 0)
  9320    . S CTR=0
  9321   "RTN","RCD PEM9",222, 0)
  9322    . F  D  Q :CTR=""
  9323   "RTN","RCD PEM9",223, 0)
  9324    . . S CTR =$O(^TMP(" RCPAYER",$ J,"B",RCPA R,CTR))
  9325   "RTN","RCD PEM9",224, 0)
  9326    . . Q:CTR =""
  9327   "RTN","RCD PEM9",225, 0)
  9328    . . W !,? 5
  9329   "RTN","RCD PEM9",226, 0)
  9330    . . W:NMO RTIN'=2 CT R,"."
  9331   "RTN","RCD PEM9",227, 0)
  9332    . . W ^TM P("RCPAYER ",$J,CTR)
  9333   "RTN","RCD PEM9",228, 0)
  9334    . . I NMO RTIN=2 D
  9335   "RTN","RCD PEM9",229, 0)
  9336    . . . S S ELPAY("RCS ELPAY",IND X)=^TMP("R CPAYER",$J ,CTR),INDX =INDX+1
  9337   "RTN","RCD PEM9",230, 0)
  9338    . . S CNT =CNT+1
  9339   "RTN","RCD PEM9",231, 0)
  9340    . . I CNT =1 S RCSAV E=^TMP("RC PAYER",$J, CTR)
  9341   "RTN","RCD PEM9",232, 0)
  9342    W:'CNT "   ??"
  9343   "RTN","RCD PEM9",233, 0)
  9344    I NMORTIN '=2,CNT=1  D  ; one m atch by na me, select  it automa tically
  9345   "RTN","RCD PEM9",234, 0)
  9346    . S ^TMP( "RCSELPAY" ,$J,INDX)= RCSAVE,IND X=INDX+1
  9347   "RTN","RCD PEM9",235, 0)
  9348    . W " - S ELECTED"
  9349   "RTN","RCD PEM9",236, 0)
  9350    Q
  9351   "RTN","RCD PEM9",237, 0)
  9352    ;
  9353   "RTN","RCD PEM9",238, 0)
  9354    ; PRCA*4. 5*318 - Ad ded parame ters & log ic for MIX ED & BLANK LN
  9355   "RTN","RCD PEM9",239, 0)
  9356   GETPAYR(MI XED,BLANKL N) ;select  payer for  filter, r ange
  9357   "RTN","RCD PEM9",240, 0)
  9358    ; called  from ^RCDP EAR1
  9359   "RTN","RCD PEM9",241, 0)
  9360    ; Input:  MIXED   -  1 to displ ay prompts  in mixed  case
  9361   "RTN","RCD PEM9",242, 0)
  9362    ;                    Optional,  defaults t o 0
  9363   "RTN","RCD PEM9",243, 0)
  9364    ;         BLANKLN -  0 skip ini tial blank  line
  9365   "RTN","RCD PEM9",244, 0)
  9366    ;                    Optional,  defaults t o 1 
  9367   "RTN","RCD PEM9",245, 0)
  9368    ;
  9369   "RTN","RCD PEM9",246, 0)
  9370    S:'$D(MIX ED) MIXED= 0            ; PRCA*4 .5*318
  9371   "RTN","RCD PEM9",247, 0)
  9372    S:'$D(BLA NKLN) BLAN KLN=1
  9373   "RTN","RCD PEM9",248, 0)
  9374    ;
  9375   "RTN","RCD PEM9",249, 0)
  9376    N DIR,DTO UT,DUOUT,D IRUT,DIROU T,INDX,X,Y ,RCINSF,RC INST,NUM
  9377   "RTN","RCD PEM9",250, 0)
  9378    S DIR("?" )="ENTER T HE NAME OF  THE PAYER  OR '??' T O LIST PAY ERS"
  9379   "RTN","RCD PEM9",251, 0)
  9380    S DIR("?? ")="^D LIS T^RCDPEM9( CNT)"
  9381   "RTN","RCD PEM9",252, 0)
  9382    S DIR(0)= "FA^1:30^K :X'?1.U.E  X"
  9383   "RTN","RCD PEM9",253, 0)
  9384    S DIR("A" )="START W ITH INSURA NCE COMPAN Y NAME: "
  9385   "RTN","RCD PEM9",254, 0)
  9386    S DIR("B" )=$E($O(^T MP("RCPAYE R",$J,"B", "")),1,30)
  9387   "RTN","RCD PEM9",255, 0)
  9388    I MIXED D          ; PRCA*4.5*3 18
  9389   "RTN","RCD PEM9",256, 0)
  9390    . S DIR(" ?")="Enter  the name  of the pay er or '??'  to list p ayers"
  9391   "RTN","RCD PEM9",257, 0)
  9392    . S DIR(" A")="Start  with Insu rance Comp any name:  "
  9393   "RTN","RCD PEM9",258, 0)
  9394    D ^DIR K  DIR
  9395   "RTN","RCD PEM9",259, 0)
  9396    I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT)!(Y="")  S RTNFLG= -1 Q
  9397   "RTN","RCD PEM9",260, 0)
  9398    S RCINSF= Y
  9399   "RTN","RCD PEM9",261, 0)
  9400    S DIR("?" )="ENTER T HE NAME OF  THE PAYER  OR '??' T O LIST PAY ERS"
  9401   "RTN","RCD PEM9",262, 0)
  9402    S DIR("?? ")="^D LIS T^RCDPEM9( CNT)"
  9403   "RTN","RCD PEM9",263, 0)
  9404    S DIR(0)= "FA^1:30^K :X'?1.U.E  X"
  9405   "RTN","RCD PEM9",264, 0)
  9406    S DIR("A" )="GO TO I NSURANCE C OMPANY NAM E: "
  9407   "RTN","RCD PEM9",265, 0)
  9408    I MIXED D          ; PRCA*4.5*3 18
  9409   "RTN","RCD PEM9",266, 0)
  9410    . S DIR(" ?")="Enter  the name  of the pay er or '??'  to list p ayers"
  9411   "RTN","RCD PEM9",267, 0)
  9412    . S DIR(" A")="Go to  Insurance  Company n ame: "
  9413   "RTN","RCD PEM9",268, 0)
  9414    S DIR("B" )=$E($O(^T MP("RCPAYE R",$J,"B", ""),-1),1, 30)
  9415   "RTN","RCD PEM9",269, 0)
  9416    ; PRCA*4. 5*318 - ad ded condit ional for  MIXED & BL ANKLN
  9417   "RTN","RCD PEM9",270, 0)
  9418    F  W:BLAN KLN ! D ^D IR Q:$S($D (DTOUT)!$D (DUOUT):1, 1:RCINSF'] Y)  D
  9419   "RTN","RCD PEM9",271, 0)
  9420    . W:'MIXE D !,"'GO T O' NAME MU ST COME AF TER 'START  WITH' NAM E"
  9421   "RTN","RCD PEM9",272, 0)
  9422    . W:MIXED  !,"'GO TO ' name mus t come aft er 'START  WITH' name "
  9423   "RTN","RCD PEM9",273, 0)
  9424    K DIR
  9425   "RTN","RCD PEM9",274, 0)
  9426    I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT)!(Y="")  S RTNFLG= -1 Q
  9427   "RTN","RCD PEM9",275, 0)
  9428    S RCINST= Y_"Z"  ;en try of "AB C" will pi ck up "ABC  INSURANCE " if "Z" i s appended
  9429   "RTN","RCD PEM9",276, 0)
  9430    ;If the f irst name  is an exac t match, b ack up to  the previo us entry
  9431   "RTN","RCD PEM9",277, 0)
  9432    I $D(^TMP ("RCPAYER" ,$J,"B",RC INSF)) S R CINSF=$O(^ TMP("RCPAY ER",$J,"B" ,RCINSF),- 1)
  9433   "RTN","RCD PEM9",278, 0)
  9434    ; PRCA*4. 5*284 - Sa ve from/th ru user re sponses in  RNG1 & RN G2 to rebu ild after  report is  queued. Wi ll be retu rned to th e calling  program.
  9435   "RTN","RCD PEM9",279, 0)
  9436    S RNG1=RC INSF,RNG2= RCINST
  9437   "RTN","RCD PEM9",280, 0)
  9438    S INDX=1  F  S RCINS F=$O(^TMP( "RCPAYER", $J,"B",RCI NSF)) Q:RC INSF=""  Q :RCINSF]RC INST  D
  9439   "RTN","RCD PEM9",281, 0)
  9440    . S NUM=$ O(^TMP("RC PAYER",$J, "B",RCINSF ,""))
  9441   "RTN","RCD PEM9",282, 0)
  9442    . S ^TMP( "RCSELPAY" ,$J,INDX)= $G(^TMP("R CPAYER",$J ,NUM))
  9443   "RTN","RCD PEM9",283, 0)
  9444    . S INDX= INDX+1
  9445   "RTN","RCD PEM9",284, 0)
  9446    ;Set retu rn value
  9447   "RTN","RCD PEM9",285, 0)
  9448    I INDX=1  S RTNFLG=- 1 Q  ; no  entries in  selected  range
  9449   "RTN","RCD PEM9",286, 0)
  9450    S RTNFLG= 1
  9451   "RTN","RCD PEM9",287, 0)
  9452    Q
  9453   "RTN","RCD PEMA1")
  9454   0^2^B72907 594
  9455   "RTN","RCD PEMA1",1,0 )
  9456   RCDPEMA1 ; EDE/FA - L IST ALL AU TO-POSTED  RECEIPTS R EPORT ;Nov  17, 2016
  9457   "RTN","RCD PEMA1",2,0 )
  9458    ;;4.5;Acc ounts Rece ivable;**3 32**;Mar 2 0, 1995;Bu ild 34
  9459   "RTN","RCD PEMA1",3,0 )
  9460    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  9461   "RTN","RCD PEMA1",4,0 )
  9462    ;
  9463   "RTN","RCD PEMA1",5,0 )
  9464    Q   ; no  direct ent ry
  9465   "RTN","RCD PEMA1",6,0 )
  9466    ;
  9467   "RTN","RCD PEMA1",7,0 )
  9468   RPTOUT(INP UT) ;EP fr om RCDPEMA P
  9469   "RTN","RCD PEMA1",8,0 )
  9470    ; Output  the report  to paper/ screen, li stman or e xcel
  9471   "RTN","RCD PEMA1",9,0 )
  9472    ; Input:    INPUT    - See REPO RT^RCDPEMA P for a co mplete des cription
  9473   "RTN","RCD PEMA1",10, 0)
  9474    ;           ^TMP($J, A1,"SEL",A 2)=Externa l Auto-Pos t Date
  9475   "RTN","RCD PEMA1",11, 0)
  9476    ;           ^TMP($J, A1,"SEL",A 3)=Externa l lower ca sed sort v alue (Paye r or User)
  9477   "RTN","RCD PEMA1",12, 0)
  9478    ;           ^TMP($J, A1,"SEL",A 2,A3,A4,A5 )=B1^B2^B3 ^B4^B5 - i f record p assed filt ers Where:
  9479   "RTN","RCD PEMA1",13, 0)
  9480    ;                                    A1 -  "RCDPE_MAP "
  9481   "RTN","RCD PEMA1",14, 0)
  9482    ;                                    A2 -  Internal A uto-Post D ate (prima ry sort)
  9483   "RTN","RCD PEMA1",15, 0)
  9484    ;                                    A3 -  Secondary  Sort Value  (Payer or  User Name )
  9485   "RTN","RCD PEMA1",16, 0)
  9486    ;                                    A4 -  IEN for fi le 344.4
  9487   "RTN","RCD PEMA1",17, 0)
  9488    ;                                    A5 -  IEN for fi le 344.41
  9489   "RTN","RCD PEMA1",18, 0)
  9490    ;                                    B1 -  Payer Name
  9491   "RTN","RCD PEMA1",19, 0)
  9492    ;                                    B2 -  User Name
  9493   "RTN","RCD PEMA1",20, 0)
  9494    ;                                    B3 -  ERA #
  9495   "RTN","RCD PEMA1",21, 0)
  9496    ;                                    B4 -  Claim #
  9497   "RTN","RCD PEMA1",22, 0)
  9498    ;                                    B5 -  Trace #
  9499   "RTN","RCD PEMA1",23, 0)
  9500    ; Output:   ^TMP("RC DPE_MAP",$ J,CTR)=Lin e - Array  of display  lines (no  headers)
  9501   "RTN","RCD PEMA1",24, 0)
  9502    ;                                              for ou tput to Li stman
  9503   "RTN","RCD PEMA1",25, 0)
  9504    ;                                              Only s et when A7 -1
  9505   "RTN","RCD PEMA1",26, 0)
  9506    ;
  9507   "RTN","RCD PEMA1",27, 0)
  9508    N A1,ADAT E,DATA,EXC EL,FIRST,L NCNT,LSTMA N,OUTYPE,P AGE,PAYER, SORT,STOP, SVAL
  9509   "RTN","RCD PEMA1",28, 0)
  9510    S (LNCNT, PAGE)=0                              ; Init ialize Lin e/Page cou nters
  9511   "RTN","RCD PEMA1",29, 0)
  9512    S $P(INPU T,"^",9)=0                           ; Line  Counter f or Listman  output
  9513   "RTN","RCD PEMA1",30, 0)
  9514    S SORT=$P (INPUT,"^" ,6)                       ; Seco ndary Sort  by Payer  or User?
  9515   "RTN","RCD PEMA1",31, 0)
  9516    S EXCEL=$ P(INPUT,"^ ",8)                      ; Outp ut to Exce l?
  9517   "RTN","RCD PEMA1",32, 0)
  9518    S LSTMAN= $P(INPUT," ^",7)                     ; Outp ut to List man?
  9519   "RTN","RCD PEMA1",33, 0)
  9520    S OUTYPE= $S(EXCEL:2 ,LSTMAN:1, 1:0)
  9521   "RTN","RCD PEMA1",34, 0)
  9522    S DATA=0, FIRST=1
  9523   "RTN","RCD PEMA1",35, 0)
  9524    I OUTYPE= 2 D                                  ; Exce l Ouput -  Print head er line
  9525   "RTN","RCD PEMA1",36, 0)
  9526    . S XX="A uto-Post D ate^"
  9527   "RTN","RCD PEMA1",37, 0)
  9528    . S XX=XX _$S(SORT=2 :"Payer",1 :"User")_" ^"
  9529   "RTN","RCD PEMA1",38, 0)
  9530    . S XX=XX _$S(SORT=2 :"User",1: "Payer")_" ^"
  9531   "RTN","RCD PEMA1",39, 0)
  9532    . S XX=XX _"ERA #^Cl aim #^Trac e #"
  9533   "RTN","RCD PEMA1",40, 0)
  9534    . W !,XX
  9535   "RTN","RCD PEMA1",41, 0)
  9536    . ;
  9537   "RTN","RCD PEMA1",42, 0)
  9538    S A1="RCD PE_MAP",ST OP=0
  9539   "RTN","RCD PEMA1",43, 0)
  9540    S ADATE=" "
  9541   "RTN","RCD PEMA1",44, 0)
  9542    F  D  Q:A DATE=""  Q :STOP
  9543   "RTN","RCD PEMA1",45, 0)
  9544    . S ADATE =$O(^TMP($ J,A1,"SEL" ,ADATE))
  9545   "RTN","RCD PEMA1",46, 0)
  9546    . Q:ADATE =""
  9547   "RTN","RCD PEMA1",47, 0)
  9548    . I OUTYP E=1 D                                ; List man Output
  9549   "RTN","RCD PEMA1",48, 0)
  9550    . . S XX= $P(INPUT," ^",9),XX=X X+1
  9551   "RTN","RCD PEMA1",49, 0)
  9552    . . I FIR ST D  ;
  9553   "RTN","RCD PEMA1",50, 0)
  9554    . . . S F IRST=0
  9555   "RTN","RCD PEMA1",51, 0)
  9556    . . E  D   ;
  9557   "RTN","RCD PEMA1",52, 0)
  9558    . . . S ^ TMP(A1,$J, XX)="",XX= XX+1
  9559   "RTN","RCD PEMA1",53, 0)
  9560    . . S ^TM P(A1,$J,XX )="Auto-Po st Date: " _^TMP($J,A 1,"SEL",AD ATE)
  9561   "RTN","RCD PEMA1",54, 0)
  9562    . . S $P( INPUT,"^", 9)=XX
  9563   "RTN","RCD PEMA1",55, 0)
  9564    . ;
  9565   "RTN","RCD PEMA1",56, 0)
  9566    . I 'OUTY PE D  Q:ST OP                        ; Outp ut to Scre en/Paper
  9567   "RTN","RCD PEMA1",57, 0)
  9568    . . I FIR ST D  Q                              ; Init ial Page H eader
  9569   "RTN","RCD PEMA1",58, 0)
  9570    . . . S F IRST=0
  9571   "RTN","RCD PEMA1",59, 0)
  9572    . . . D P HEADER(INP UT,.LNCNT, .PAGE)
  9573   "RTN","RCD PEMA1",60, 0)
  9574    . . . W ! ,"Auto-Pos t Date: "_ ^TMP($J,A1 ,"SEL",ADA TE)
  9575   "RTN","RCD PEMA1",61, 0)
  9576    . . . S L NCNT=LNCNT +1
  9577   "RTN","RCD PEMA1",62, 0)
  9578    . . I (LN CNT+6)>IOS L D  Q:STO P              ; Page  break
  9579   "RTN","RCD PEMA1",63, 0)
  9580    . . . S S TOP=$$ASKS TOP^RCDPEM AP()
  9581   "RTN","RCD PEMA1",64, 0)
  9582    . . . Q:S TOP
  9583   "RTN","RCD PEMA1",65, 0)
  9584    . . . D P HEADER(INP UT,.LNCNT, .PAGE)         ; Page  Header
  9585   "RTN","RCD PEMA1",66, 0)
  9586    . . I LNC NT>7 W ! S  LNCNT=LNC NT+1
  9587   "RTN","RCD PEMA1",67, 0)
  9588    . . W !," Auto-Post  Date: "_^T MP($J,A1," SEL",ADATE )
  9589   "RTN","RCD PEMA1",68, 0)
  9590    . . S LNC NT=LNCNT+1
  9591   "RTN","RCD PEMA1",69, 0)
  9592    . D RPT2( .INPUT,A1, ADATE,SORT ,OUTYPE,.L NCNT,.STOP ,.DATA)
  9593   "RTN","RCD PEMA1",70, 0)
  9594    I 'DATA,' EXCEL,'LST MAN D
  9595   "RTN","RCD PEMA1",71, 0)
  9596    . D PHEAD ER(INPUT,. LNCNT,.PAG E)
  9597   "RTN","RCD PEMA1",72, 0)
  9598    I 'EXCEL  D
  9599   "RTN","RCD PEMA1",73, 0)
  9600    . S XX=$$ ENDORPRT^R CDPEARL
  9601   "RTN","RCD PEMA1",74, 0)
  9602    . I OUTYP E=1 D  Q
  9603   "RTN","RCD PEMA1",75, 0)
  9604    . . S YY= $P(INPUT," ^",9)+1
  9605   "RTN","RCD PEMA1",76, 0)
  9606    . . S $P( INPUT,"^", 9)=YY
  9607   "RTN","RCD PEMA1",77, 0)
  9608    . . S ^TM P(A1,$J,YY )=XX
  9609   "RTN","RCD PEMA1",78, 0)
  9610    . W !,XX
  9611   "RTN","RCD PEMA1",79, 0)
  9612    I (OUTYPE '=1),'STOP ,$$ASKSTOP ^RCDPEMAP( )
  9613   "RTN","RCD PEMA1",80, 0)
  9614    Q
  9615   "RTN","RCD PEMA1",81, 0)
  9616    ;
  9617   "RTN","RCD PEMA1",82, 0)
  9618   RPT2(INPUT ,A1,ADATE, SORT,OUTYP E,LNCNT,ST OP,DATA) ;  Report Ou tput Conti nued
  9619   "RTN","RCD PEMA1",83, 0)
  9620    ; Input:    INPUT    - See REPO RT^RCDPEMA P for deta il
  9621   "RTN","RCD PEMA1",84, 0)
  9622    ;           ADATE    - Internal  Auto-Post  Date
  9623   "RTN","RCD PEMA1",85, 0)
  9624    ;           SORT     - 2 - Sort  by User,  1 - Sort b y Payer
  9625   "RTN","RCD PEMA1",86, 0)
  9626    ;           OUTYPE   - 2 - Exce l, 1 - Lis tman, 0 -  Paper/Scre en
  9627   "RTN","RCD PEMA1",87, 0)
  9628    ;           LNCNT    - Current  line count  (only if  OUTYPE=0)
  9629   "RTN","RCD PEMA1",88, 0)
  9630    ;           ^TMP($J, A1,"SEL",. ..) - See  RPTOUT for  details
  9631   "RTN","RCD PEMA1",89, 0)
  9632    ; Output:   LNCNT    - Updated  line count  (only if  OUTYPE=0)
  9633   "RTN","RCD PEMA1",90, 0)
  9634    ;           STOP     - 1 if use r quit out  (only if  OUTYPE=0)
  9635   "RTN","RCD PEMA1",91, 0)
  9636    ;           INPUT    - 9th '^'  piece upda te with cu rrent line  # is OUTY PE=1
  9637   "RTN","RCD PEMA1",92, 0)
  9638    ;           DATA     - 1 if at  least one  line of da ta is foun t
  9639   "RTN","RCD PEMA1",93, 0)
  9640    ;           ^TMP("RC DPE_MAP",$ J,CTR) - O utput line s for List man (only  if OUTYPE= 1)
  9641   "RTN","RCD PEMA1",94, 0)
  9642    N CURS,SV AL,LASTS,X X
  9643   "RTN","RCD PEMA1",95, 0)
  9644    S SVAL="" ,XX=$O(^TM P($J,A1,"S EL",ADATE, ""))
  9645   "RTN","RCD PEMA1",96, 0)
  9646    S LASTS=^ TMP($J,A1, "SEL",ADAT E,XX)
  9647   "RTN","RCD PEMA1",97, 0)
  9648    F  D  Q:S VAL=""  Q: STOP
  9649   "RTN","RCD PEMA1",98, 0)
  9650    . S SVAL= $O(^TMP($J ,A1,"SEL", ADATE,SVAL ))
  9651   "RTN","RCD PEMA1",99, 0)
  9652    . Q:SVAL= ""
  9653   "RTN","RCD PEMA1",100 ,0)
  9654    . S CURS= ^TMP($J,A1 ,"SEL",ADA TE,SVAL)       ; Curr ent lower  case Payer  or User N ame
  9655   "RTN","RCD PEMA1",101 ,0)
  9656    . I OUTYP E=1 D                                ; List man output
  9657   "RTN","RCD PEMA1",102 ,0)
  9658    . . S XX= $P(INPUT," ^",9)
  9659   "RTN","RCD PEMA1",103 ,0)
  9660    . . I CUR S'=LASTS D
  9661   "RTN","RCD PEMA1",104 ,0)
  9662    . . . S X X=XX+1,^TM P(A1,$J,XX )=""
  9663   "RTN","RCD PEMA1",105 ,0)
  9664    . . S XX= XX+1,^TMP( A1,$J,XX)= "  "_$S(SO RT=2:"Paye r: ",1:"Us er: ")_CUR S
  9665   "RTN","RCD PEMA1",106 ,0)
  9666    . . S $P( INPUT,"^", 9)=XX
  9667   "RTN","RCD PEMA1",107 ,0)
  9668    . ;
  9669   "RTN","RCD PEMA1",108 ,0)
  9670    . I 'OUTY PE D  Q:ST OP                        ; Outp ut to Pape r/Screen
  9671   "RTN","RCD PEMA1",109 ,0)
  9672    . . I (LN CNT+4)>IOS L D  Q:STO P              ; Page  break
  9673   "RTN","RCD PEMA1",110 ,0)
  9674    . . . S S TOP=$$ASKS TOP^RCDPEM AP()
  9675   "RTN","RCD PEMA1",111 ,0)
  9676    . . . Q:S TOP
  9677   "RTN","RCD PEMA1",112 ,0)
  9678    . . . D P HEADER(INP UT,.LNCNT, .PAGE)          ; Pri nt Page He ader
  9679   "RTN","RCD PEMA1",113 ,0)
  9680    . . . W ! ,"Auto-Pos t Date: "_ ^TMP($J,A1 ,"SEL",ADA TE)
  9681   "RTN","RCD PEMA1",114 ,0)
  9682    . . . ; W  !,CURS
  9683   "RTN","RCD PEMA1",115 ,0)
  9684    . . . S L NCNT=LNCNT +3
  9685   "RTN","RCD PEMA1",116 ,0)
  9686    . . I CUR S'=LASTS D
  9687   "RTN","RCD PEMA1",117 ,0)
  9688    . . . S L NCNT=LNCNT +1,LASTS=C URS
  9689   "RTN","RCD PEMA1",118 ,0)
  9690    . . . W !
  9691   "RTN","RCD PEMA1",119 ,0)
  9692    . . W !,"   ",$S(SOR T=2:"Payer : ",1:"Use r: "),CURS
  9693   "RTN","RCD PEMA1",120 ,0)
  9694    . . S LNC NT=LNCNT+1
  9695   "RTN","RCD PEMA1",121 ,0)
  9696    . D RPT3( .INPUT,A1, ADATE,SORT ,SVAL,OUTY PE,.LNCNT, .STOP,.DAT A)
  9697   "RTN","RCD PEMA1",122 ,0)
  9698    Q
  9699   "RTN","RCD PEMA1",123 ,0)
  9700    ;
  9701   "RTN","RCD PEMA1",124 ,0)
  9702   RPT3(INPUT ,A1,ADATE, SORT,SVAL, OUTYPE,LNC NT,STOP,DA TA) ;  Rep ort Output  Continued
  9703   "RTN","RCD PEMA1",125 ,0)
  9704    ; Input:    INPUT    - See REPO RT^RCDPEMA P for deta il
  9705   "RTN","RCD PEMA1",126 ,0)
  9706    ;           ADATE    - Internal  Auto-Post  Date
  9707   "RTN","RCD PEMA1",127 ,0)
  9708    ;           SORT     - 1 - Sort  by User,  2 - Sort b y Payer
  9709   "RTN","RCD PEMA1",128 ,0)
  9710    ;           SVAL     - Current  sort value  (Upper ca sed Payer  or User Na me)
  9711   "RTN","RCD PEMA1",129 ,0)
  9712    ;           OUTYPE   - 2 - Exce l, 1 - Lis tman, 0 -  Paper/Scre en
  9713   "RTN","RCD PEMA1",130 ,0)
  9714    ;           LNCNT    - Current  line count  (only if  OUTYPE=0)
  9715   "RTN","RCD PEMA1",131 ,0)
  9716    ;           ^TMP($J, A1,"SEL",. ..2) - See  RPTOUT fo r details
  9717   "RTN","RCD PEMA1",132 ,0)
  9718    ; Output:   LNCNT     - Updated  line coun t (only if  OUTYPE=0)
  9719   "RTN","RCD PEMA1",133 ,0)
  9720    ;           STOP     - 1 if use r quit out  (only if  OUTYPE=0)
  9721   "RTN","RCD PEMA1",134 ,0)
  9722    ;           INPUT    - 9th '^'  piece upda te with cu rrent line  # is OUTY PE=1
  9723   "RTN","RCD PEMA1",135 ,0)
  9724    ;           DATA     - 1 if at  least one  line of da ta is foun d
  9725   "RTN","RCD PEMA1",136 ,0)
  9726    ;           ^TMP("RC DPE_MAP",$ J,CTR) - O utput line s for List man (only  if OUTYPE= 1)
  9727   "RTN","RCD PEMA1",137 ,0)
  9728    N DATAR,F IRSTS,IEN3 444,IEN344 41,LN1,LN2 ,LN3,UORP, UORPF,UORP L,XX,YY
  9729   "RTN","RCD PEMA1",138 ,0)
  9730    S IEN3444 ="",FIRSTS =1,UORPF=1
  9731   "RTN","RCD PEMA1",139 ,0)
  9732    F  D  Q:I EN3444=""   Q:STOP
  9733   "RTN","RCD PEMA1",140 ,0)
  9734    . S IEN34 44=$O(^TMP ($J,A1,"SE L",ADATE,S VAL,IEN344 4))
  9735   "RTN","RCD PEMA1",141 ,0)
  9736    . Q:IEN34 44=""
  9737   "RTN","RCD PEMA1",142 ,0)
  9738    . S IEN34 441=""
  9739   "RTN","RCD PEMA1",143 ,0)
  9740    . S XX=$O (^TMP($J,A 1,"SEL",AD ATE,SVAL,I EN3444,"") )
  9741   "RTN","RCD PEMA1",144 ,0)
  9742    . S XX=^T MP($J,A1," SEL",ADATE ,SVAL,IEN3 444,XX)
  9743   "RTN","RCD PEMA1",145 ,0)
  9744    . S UORPL =$P(XX,"^" ,SORT)
  9745   "RTN","RCD PEMA1",146 ,0)
  9746    . F  D  Q :IEN34441= ""
  9747   "RTN","RCD PEMA1",147 ,0)
  9748    . . S IEN 34441=$O(^ TMP($J,A1, "SEL",ADAT E,SVAL,IEN 3444,IEN34 441))
  9749   "RTN","RCD PEMA1",148 ,0)
  9750    . . Q:IEN 34441=""
  9751   "RTN","RCD PEMA1",149 ,0)
  9752    . . S DAT A=1                                  ; foun d data
  9753   "RTN","RCD PEMA1",150 ,0)
  9754    . . ;
  9755   "RTN","RCD PEMA1",151 ,0)
  9756    . . S DAT AR=^TMP($J ,A1,"SEL", ADATE,SVAL ,IEN3444,I EN34441)
  9757   "RTN","RCD PEMA1",152 ,0)
  9758    . . S:SOR T=2 LN1="   Payer: "_ $P(DATAR," ^",1),LN2= "    User:  "_$P(DATA R,"^",2)
  9759   "RTN","RCD PEMA1",153 ,0)
  9760    . . S:SOR T=1 LN1="   User: "_$ P(DATAR,"^ ",2),LN2="     Payer:  "_$P(DATA R,"^",1)
  9761   "RTN","RCD PEMA1",154 ,0)
  9762    . . S LN3 =$P(DATAR, "^",3)                    ; ERA  #
  9763   "RTN","RCD PEMA1",155 ,0)
  9764    . . S YY= $P(DATAR," ^",4)                     ; Clai m #
  9765   "RTN","RCD PEMA1",156 ,0)
  9766    . . S LN3 =$$SETSTR^ VALM1(YY,L N3,13,10)
  9767   "RTN","RCD PEMA1",157 ,0)
  9768    . . S YY= $P(DATAR," ^",5)                     ; Trac e #
  9769   "RTN","RCD PEMA1",158 ,0)
  9770    . . S LN3 =$$SETSTR^ VALM1(YY,L N3,25,50)
  9771   "RTN","RCD PEMA1",159 ,0)
  9772    . . S UOR P=$P(DATAR ,"^",SORT)
  9773   "RTN","RCD PEMA1",160 ,0)
  9774    . . I OUT YPE=2 D  Q                           ; Exce l Output
  9775   "RTN","RCD PEMA1",161 ,0)
  9776    . . . S X X=^TMP($J, A1,"SEL",A DATE)_"^"
  9777   "RTN","RCD PEMA1",162 ,0)
  9778    . . . I S ORT=1 D
  9779   "RTN","RCD PEMA1",163 ,0)
  9780    . . . . S  XX=XX_$P( DATAR,"^", 2)_"^"_$P( DATAR,"^", 1)
  9781   "RTN","RCD PEMA1",164 ,0)
  9782    . . . E   D
  9783   "RTN","RCD PEMA1",165 ,0)
  9784    . . . . S  XX=XX_$P( DATAR,"^", 1,2)
  9785   "RTN","RCD PEMA1",166 ,0)
  9786    . . . S X X=XX_"^"_$ P(DATAR,"^ ",3,5)
  9787   "RTN","RCD PEMA1",167 ,0)
  9788    . . . W ! ,XX
  9789   "RTN","RCD PEMA1",168 ,0)
  9790    . . ;
  9791   "RTN","RCD PEMA1",169 ,0)
  9792    . . ; Lis tman outpu t
  9793   "RTN","RCD PEMA1",170 ,0)
  9794    . . I OUT YPE=1 D RP T3LM(A1,.I NPUT,.FIRS TS,.UORP,. UORPL,.UOR PF,LN2,LN3 ) Q
  9795   "RTN","RCD PEMA1",171 ,0)
  9796    . . ;
  9797   "RTN","RCD PEMA1",172 ,0)
  9798    . . ; Out put to Pap er/Screen  - check if  we need a  page brea k
  9799   "RTN","RCD PEMA1",173 ,0)
  9800    . . I (LN CNT+2)>IOS L D  Q:STO P
  9801   "RTN","RCD PEMA1",174 ,0)
  9802    . . . S S TOP=$$ASKS TOP^RCDPEM AP()
  9803   "RTN","RCD PEMA1",175 ,0)
  9804    . . . Q:S TOP
  9805   "RTN","RCD PEMA1",176 ,0)
  9806    . . . D P HEADER(INP UT,.LNCNT, .PAGE)
  9807   "RTN","RCD PEMA1",177 ,0)
  9808    . . . W ! ,"Auto-Pos t Date: "_ ^TMP($J,A1 ,"SEL",ADA TE)
  9809   "RTN","RCD PEMA1",178 ,0)
  9810    . . . S L NCNT=LNCNT +1
  9811   "RTN","RCD PEMA1",179 ,0)
  9812    . . . W ! ,LN1
  9813   "RTN","RCD PEMA1",180 ,0)
  9814    . . . S L NCNT=LNCNT +1
  9815   "RTN","RCD PEMA1",181 ,0)
  9816    . . . W ! ,LN2
  9817   "RTN","RCD PEMA1",182 ,0)
  9818    . . . S L NCNT=LNCNT +1
  9819   "RTN","RCD PEMA1",183 ,0)
  9820    . . I UOR P'=UORPL D
  9821   "RTN","RCD PEMA1",184 ,0)
  9822    . . . S U ORPL=UORP, LNCNT=LNCT +2,UORPF=0
  9823   "RTN","RCD PEMA1",185 ,0)
  9824    . . . I L NCNT>7 W !  S LNCNT=L NCNT+1
  9825   "RTN","RCD PEMA1",186 ,0)
  9826    . . . W ! ,LN2 S LNC NT=LNCNT+1
  9827   "RTN","RCD PEMA1",187 ,0)
  9828    . . I UOR PF D
  9829   "RTN","RCD PEMA1",188 ,0)
  9830    . . . S L NCNT=LNCNT +1,UORPF=0
  9831   "RTN","RCD PEMA1",189 ,0)
  9832    . . . W ! ,LN2 S LNC NT=LNCNT+1
  9833   "RTN","RCD PEMA1",190 ,0)
  9834    . . W !,L N3
  9835   "RTN","RCD PEMA1",191 ,0)
  9836    . . S LNC NT=LNCNT+1
  9837   "RTN","RCD PEMA1",192 ,0)
  9838    Q
  9839   "RTN","RCD PEMA1",193 ,0)
  9840    ;
  9841   "RTN","RCD PEMA1",194 ,0)
  9842   RPT3LM(A1, INPUT,FIRS TS,UORP,UO RPL,UORPF, LN2,LN3) ;  Continue  listman ou tput
  9843   "RTN","RCD PEMA1",195 ,0)
  9844    ; Input:    A1       - "RCDPE_M AP"
  9845   "RTN","RCD PEMA1",196 ,0)
  9846    ;           INPUT    - 9th piec e contains  the curre nt listman  line coun ter
  9847   "RTN","RCD PEMA1",197 ,0)
  9848    ;           FIRSTS   - 1 if thi s is the f irst Payer  for the c urrent dat e, 0 other wise
  9849   "RTN","RCD PEMA1",198 ,0)
  9850    ;           UORP     - Current  User or Pa yer Name ( whichever  we're not  sorting by )
  9851   "RTN","RCD PEMA1",199 ,0)
  9852    ;           UORPL    - Current  last User  or Payer N ame (which ever we're  not sorti ng by)
  9853   "RTN","RCD PEMA1",200 ,0)
  9854    ;           UORPF    - 1 if thi s is the f irst user  or payer f or the cur rent sor v alue
  9855   "RTN","RCD PEMA1",201 ,0)
  9856    ;                      0 otherw ise
  9857   "RTN","RCD PEMA1",202 ,0)
  9858    ;           LN2      - Payer or  User Name  (whatever  is not th e sort) di splay line
  9859   "RTN","RCD PEMA1",203 ,0)
  9860    ;           LN3      - ERA disp lay line
  9861   "RTN","RCD PEMA1",204 ,0)
  9862    ;           ^TMP(A1, $J,XX)  -  Current li stman disp lay lines
  9863   "RTN","RCD PEMA1",205 ,0)
  9864    ; Output:   INPUT    - Updated  9th piece  contains t he current  listman l ine counte r
  9865   "RTN","RCD PEMA1",206 ,0)
  9866    ;           FIRSTS   - Updated  to 0 (pote ntially)
  9867   "RTN","RCD PEMA1",207 ,0)
  9868    ;           UORP     - Updated  User or Pa yer Name ( potentiall y)
  9869   "RTN","RCD PEMA1",208 ,0)
  9870    ;           UORPL    - Updated  last User  or Payer N ame (poten tially)
  9871   "RTN","RCD PEMA1",209 ,0)
  9872    ;           UORPF    - Updated
  9873   "RTN","RCD PEMA1",210 ,0)
  9874    ;           ^TMP(A1, $J,XX)  -  Current li stman disp lay lines
  9875   "RTN","RCD PEMA1",211 ,0)
  9876    N XX
  9877   "RTN","RCD PEMA1",212 ,0)
  9878    S XX=$P(I NPUT,"^",9 )
  9879   "RTN","RCD PEMA1",213 ,0)
  9880    I UORPF D                                      ; firs t User or  Payer for  sort value  and date
  9881   "RTN","RCD PEMA1",214 ,0)
  9882    . S UORPF =0,XX=XX+1 ,UORPL=UOR P
  9883   "RTN","RCD PEMA1",215 ,0)
  9884    . S ^TMP( A1,$J,XX)= LN2
  9885   "RTN","RCD PEMA1",216 ,0)
  9886    I UORP'=U ORPL D                               ; Diff erent User  or Payer  for date
  9887   "RTN","RCD PEMA1",217 ,0)
  9888    . S UORPL =UORP,UORP F=0
  9889   "RTN","RCD PEMA1",218 ,0)
  9890    . S XX=XX +1
  9891   "RTN","RCD PEMA1",219 ,0)
  9892    . S ^TMP( A1,$J,XX)= ""
  9893   "RTN","RCD PEMA1",220 ,0)
  9894    . S XX=XX +1
  9895   "RTN","RCD PEMA1",221 ,0)
  9896    . S ^TMP( A1,$J,XX)= LN2
  9897   "RTN","RCD PEMA1",222 ,0)
  9898    S XX=XX+1
  9899   "RTN","RCD PEMA1",223 ,0)
  9900    S ^TMP(A1 ,$J,XX)=LN 3
  9901   "RTN","RCD PEMA1",224 ,0)
  9902    S $P(INPU T,"^",9)=X X
  9903   "RTN","RCD PEMA1",225 ,0)
  9904    Q
  9905   "RTN","RCD PEMA1",226 ,0)
  9906    ;
  9907   "RTN","RCD PEMA1",227 ,0)
  9908   PHEADER(IN PUT,LNCNT, PAGE) ; Di splay a Pa ge Header
  9909   "RTN","RCD PEMA1",228 ,0)
  9910    ; Input:    INPUT    - See REPO RT for a c omplete de scription
  9911   "RTN","RCD PEMA1",229 ,0)
  9912    ;           LNCNT    - Current  Line Count
  9913   "RTN","RCD PEMA1",230 ,0)
  9914    ;           PAGE     - Current  Page Count
  9915   "RTN","RCD PEMA1",231 ,0)
  9916    ; Output:   LNCNT    - Updated  Line Count
  9917   "RTN","RCD PEMA1",232 ,0)
  9918    ;           PAGE     - Updated  Page Count
  9919   "RTN","RCD PEMA1",233 ,0)
  9920    N XX,YY,Z Z
  9921   "RTN","RCD PEMA1",234 ,0)
  9922    S YY="EEO Bs Marked  for Auto-P ost Audit  Report",PA GE=PAGE+1
  9923   "RTN","RCD PEMA1",235 ,0)
  9924    S XX=$$NO W^XLFDT(), XX=$$FMTE^ XLFDT(XX)
  9925   "RTN","RCD PEMA1",236 ,0)
  9926    S XX=$$SE TSTR^VALM1 (XX,YY,42, 21)
  9927   "RTN","RCD PEMA1",237 ,0)
  9928    S YY="Pag e: "_$J(PA GE,3)
  9929   "RTN","RCD PEMA1",238 ,0)
  9930    S XX=$$SE TSTR^VALM1 (YY,XX,69, $L(YY))
  9931   "RTN","RCD PEMA1",239 ,0)
  9932    W @IOF,XX
  9933   "RTN","RCD PEMA1",240 ,0)
  9934    S LNCNT=1
  9935   "RTN","RCD PEMA1",241 ,0)
  9936    ;
  9937   "RTN","RCD PEMA1",242 ,0)
  9938    S XX=$$HD RLN2(INPUT )
  9939   "RTN","RCD PEMA1",243 ,0)
  9940    W !,XX
  9941   "RTN","RCD PEMA1",244 ,0)
  9942    S LNCNT=L NCNT+1
  9943   "RTN","RCD PEMA1",245 ,0)
  9944    ;
  9945   "RTN","RCD PEMA1",246 ,0)
  9946    S XX=$$HD RLN3(INPUT )
  9947   "RTN","RCD PEMA1",247 ,0)
  9948    W !,XX
  9949   "RTN","RCD PEMA1",248 ,0)
  9950    S LNCNT=L NCNT+1
  9951   "RTN","RCD PEMA1",249 ,0)
  9952    ; 
  9953   "RTN","RCD PEMA1",250 ,0)
  9954    S XX=$$HD RLN4(INPUT )
  9955   "RTN","RCD PEMA1",251 ,0)
  9956    W !,XX
  9957   "RTN","RCD PEMA1",252 ,0)
  9958    S LNCNT=L NCNT+1
  9959   "RTN","RCD PEMA1",253 ,0)
  9960    ;
  9961   "RTN","RCD PEMA1",254 ,0)
  9962    S LNCNT=L NCNT+1
  9963   "RTN","RCD PEMA1",255 ,0)
  9964    W !,"ERA  #       Cl aim #      Trace #"
  9965   "RTN","RCD PEMA1",256 ,0)
  9966    S LNCNT=L NCNT+1
  9967   "RTN","RCD PEMA1",257 ,0)
  9968    W !,"---- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ------"
  9969   "RTN","RCD PEMA1",258 ,0)
  9970    S LNCNT=L NCNT+1
  9971   "RTN","RCD PEMA1",259 ,0)
  9972    Q 
  9973   "RTN","RCD PEMA1",260 ,0)
  9974    ;
  9975   "RTN","RCD PEMA1",261 ,0)
  9976   HDRLN2(INP UT) ; Buil d the 2nd  header lin e
  9977   "RTN","RCD PEMA1",262 ,0)
  9978    ; Input:    INPUT    - See REPO RT^RCDPEMA P for a co mplete des cription
  9979   "RTN","RCD PEMA1",263 ,0)
  9980    ; Returns : Text for  2nd heade r line
  9981   "RTN","RCD PEMA1",264 ,0)
  9982    N XX
  9983   "RTN","RCD PEMA1",265 ,0)
  9984    S XX="Div s : "_$S($ P(INPUT,"^ ",1)=1:"Al l",1:$$DIV S(.RCVAUTD ))
  9985   "RTN","RCD PEMA1",266 ,0)
  9986    Q XX
  9987   "RTN","RCD PEMA1",267 ,0)
  9988    ;
  9989   "RTN","RCD PEMA1",268 ,0)
  9990   HDRLN3(INP UT) ; Buil d the 3rd  header lin e
  9991   "RTN","RCD PEMA1",269 ,0)
  9992    ; Input:    INPUT    - See REPO RT^RCDPEMA P for a co mplete des cription
  9993   "RTN","RCD PEMA1",270 ,0)
  9994    ; Returns : Text for  3rd heade r line
  9995   "RTN","RCD PEMA1",271 ,0)
  9996    N XX,YY,Z Z
  9997   "RTN","RCD PEMA1",272 ,0)
  9998    S YY=$P(I NPUT,"^",3 )
  9999   "RTN","RCD PEMA1",273 ,0)
  10000    S XX="M/P /T: "_$S(Y Y="A":"All ",YY="M":" Medical",Y Y="P":"Pha rmacy ",1: "Tricare") _" - "
  10001   "RTN","RCD PEMA1",274 ,0)
  10002    S XX=XX_$ S($P(INPUT ,"^",4)="A ":" All",1 :" Sel")_"  Payers"
  10003   "RTN","RCD PEMA1",275 ,0)
  10004    S YY=$P($ P(INPUT,"^ ",2),"|",1 ),YY="Auto -Post Date : "_$$FMTE ^XLFDT(YY, "2Z")
  10005   "RTN","RCD PEMA1",276 ,0)
  10006    S ZZ=$P($ P(INPUT,"^ ",2),"|",2 ),ZZ=$$FMT E^XLFDT(ZZ ,"2Z")
  10007   "RTN","RCD PEMA1",277 ,0)
  10008    S YY=YY_" -"_ZZ
  10009   "RTN","RCD PEMA1",278 ,0)
  10010    S XX=$$SE TSTR^VALM1 (YY,XX,40, $L(YY))
  10011   "RTN","RCD PEMA1",279 ,0)
  10012    Q XX
  10013   "RTN","RCD PEMA1",280 ,0)
  10014    ;
  10015   "RTN","RCD PEMA1",281 ,0)
  10016   HDRLN4(INP UT) ; Buil d the 4th  header lin e
  10017   "RTN","RCD PEMA1",282 ,0)
  10018    ; Input:    INPUT    - See REPO RT^RCDPEMA P for a co mplete des cription
  10019   "RTN","RCD PEMA1",283 ,0)
  10020    ; Returns : Text for  4th heade r line
  10021   "RTN","RCD PEMA1",284 ,0)
  10022    N XX,YY,Z Z
  10023   "RTN","RCD PEMA1",285 ,0)
  10024    S YY=$P(I NPUT,"^",4 )
  10025   "RTN","RCD PEMA1",286 ,0)
  10026    S XX="Use rs: "_$S($ P(INPUT,"^ ",5)=1:"Al l ",1:"Sel ected")
  10027   "RTN","RCD PEMA1",287 ,0)
  10028    S YY="Sor t: "_$S($P (INPUT,"^" ,6)=1:"Use r ",1:"Pay er ")_"Nam e"
  10029   "RTN","RCD PEMA1",288 ,0)
  10030    S XX=$$SE TSTR^VALM1 (YY,XX,50, $L(YY))
  10031   "RTN","RCD PEMA1",289 ,0)
  10032    Q XX
  10033   "RTN","RCD PEMA1",290 ,0)
  10034    ;
  10035   "RTN","RCD PEMA1",291 ,0)
  10036   DIVS(VAUTD ) ;
  10037   "RTN","RCD PEMA1",292 ,0)
  10038    ; Input -  VAUTD arr ay of divi sions sele cted
  10039   "RTN","RCD PEMA1",293 ,0)
  10040    ; Returns  - List of  station n umbers
  10041   "RTN","RCD PEMA1",294 ,0)
  10042    N RETURN, XX,Z0,Z1
  10043   "RTN","RCD PEMA1",295 ,0)
  10044    S Z1=""
  10045   "RTN","RCD PEMA1",296 ,0)
  10046    S Z0=0
  10047   "RTN","RCD PEMA1",297 ,0)
  10048    F  D  Q:' Z0
  10049   "RTN","RCD PEMA1",298 ,0)
  10050    . S Z0=$O (VAUTD(Z0) )
  10051   "RTN","RCD PEMA1",299 ,0)
  10052    . Q:'Z0
  10053   "RTN","RCD PEMA1",300 ,0)
  10054    . S XX=$$ GET1^DIQ(4 0.8,Z0,1," I") ;Facil ity Number    ;PRCA*4 .5*321
  10055   "RTN","RCD PEMA1",301 ,0)
  10056    . S Z1=Z1 _XX_", "
  10057   "RTN","RCD PEMA1",302 ,0)
  10058    S RETURN= $E(Z1,1,$L (Z1)-2)
  10059   "RTN","RCD PEMA1",303 ,0)
  10060    Q RETURN
  10061   "RTN","RCD PEMAP")
  10062   0^1^B10569 5606
  10063   "RTN","RCD PEMAP",1,0 )
  10064   RCDPEMAP ; AITC/FA -  LIST ALL A UTO-POSTED  RECEIPTS  REPORT ;No v 17, 2016
  10065   "RTN","RCD PEMAP",2,0 )
  10066    ;;4.5;Acc ounts Rece ivable;**3 32**;Mar 2 0, 1995;Bu ild 34
  10067   "RTN","RCD PEMAP",3,0 )
  10068    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  10069   "RTN","RCD PEMAP",4,0 )
  10070    ;
  10071   "RTN","RCD PEMAP",5,0 )
  10072   EN ; Main  entry poin t
  10073   "RTN","RCD PEMAP",6,0 )
  10074    N INPUT,R CPAR,RCVAU TD,XX,YY
  10075   "RTN","RCD PEMAP",7,0 )
  10076    K ^TMP($J ,"RCDPE_MA P"),^TMP(" RCDPE_MAP" ,$J)
  10077   "RTN","RCD PEMAP",8,0 )
  10078    K ^TMP("R CSELPAY",$ J),^TMP($J ,"SELPAYER "),^TMP($J ,"SELUSER" )
  10079   "RTN","RCD PEMAP",9,0 )
  10080    ;
  10081   "RTN","RCD PEMAP",10, 0)
  10082    S INPUT=$ $STADIV(.R CVAUTD)                   ; Divi sion filte r
  10083   "RTN","RCD PEMAP",11, 0)
  10084    Q:'INPUT                                       ; '^'  or timeout
  10085   "RTN","RCD PEMAP",12, 0)
  10086    S $P(INPU T,"^",2)=$ $DTRNG(0)                 ; Star t Date|End  date
  10087   "RTN","RCD PEMAP",13, 0)
  10088    Q:'$P(INP UT,"^",2)                            ; '^'  or timeout
  10089   "RTN","RCD PEMAP",14, 0)
  10090    S $P(INPU T,"^",3)=$ $RTYPE^RCD PEU1("")       ; M/P/ T filter
  10091   "RTN","RCD PEMAP",15, 0)
  10092    Q:$P(INPU T,"^",3)<0                           ; '^'  or timeout
  10093   "RTN","RCD PEMAP",16, 0)
  10094    S RCPAR(" SELC")=$$P AYRNG^RCDP EU1()          ; Sele cted or Ra nge of Pay ers
  10095   "RTN","RCD PEMAP",17, 0)
  10096    Q:RCPAR(" SELC")=-1                            ; '^'  or timeout
  10097   "RTN","RCD PEMAP",18, 0)
  10098    S $P(INPU T,"^",4)=R CPAR("SELC ")
  10099   "RTN","RCD PEMAP",19, 0)
  10100    ;
  10101   "RTN","RCD PEMAP",20, 0)
  10102    I RCPAR(" SELC")'="A " D  Q:XX= -1             ; Sinc e we don't  want all  payers 
  10103   "RTN","RCD PEMAP",21, 0)
  10104    . S RCPAR ("TYPE")=$ P(INPUT,"^ ",3)           ; prom pt for pay ers we do  want
  10105   "RTN","RCD PEMAP",22, 0)
  10106    . S RCPAR ("FILE")=3 44.4
  10107   "RTN","RCD PEMAP",23, 0)
  10108    . S RCPAR ("DICA")=" Select Ins urance Com pany NAME:  "
  10109   "RTN","RCD PEMAP",24, 0)
  10110    . S XX=$$ SELPAY^RCD PEU1(.RCPA R)
  10111   "RTN","RCD PEMAP",25, 0)
  10112    ;
  10113   "RTN","RCD PEMAP",26, 0)
  10114    S $P(INPU T,"^",5)=$ $SELUSER()                ; Sele cted or Al l users fi lter
  10115   "RTN","RCD PEMAP",27, 0)
  10116    Q:$P(INPU T,"^",5)<0                           ; '^'  or timeout
  10117   "RTN","RCD PEMAP",28, 0)
  10118    ;
  10119   "RTN","RCD PEMAP",29, 0)
  10120    I $P(INPU T,"^",5)=2  D  Q:XX=- 1              ; Prom pt for sel ected user s
  10121   "RTN","RCD PEMAP",30, 0)
  10122    . S XX=$$ SELUSER2()
  10123   "RTN","RCD PEMAP",31, 0)
  10124    ;
  10125   "RTN","RCD PEMAP",32, 0)
  10126    S $P(INPU T,"^",6)=$ $SECSORT()                ; Seco ndary Sort
  10127   "RTN","RCD PEMAP",33, 0)
  10128    Q:$P(INPU T,"^",6)<0                           ; '^'  or timeout
  10129   "RTN","RCD PEMAP",34, 0)
  10130    S $P(INPU T,"^",7)=$ $ASKLM^RCD PEARL          ; Ask  to Display  in Listma n Template
  10131   "RTN","RCD PEMAP",35, 0)
  10132    Q:$P(INPU T,"^",7)<0                           ; '^'  or timeout
  10133   "RTN","RCD PEMAP",36, 0)
  10134    I $P(INPU T,"^",7)=1  D  Q                     ; Comp ile data a nd call li stman to d isplay
  10135   "RTN","RCD PEMAP",37, 0)
  10136    . D LMOUT (INPUT,.RC VAUTD,.IO)
  10137   "RTN","RCD PEMAP",38, 0)
  10138    S $P(INPU T,"^",8)=$ $EXCEL()                  ; Ask  to output  to Excel
  10139   "RTN","RCD PEMAP",39, 0)
  10140    Q:$P(INPU T,"^",8)=- 1                         ; '^'  or timeout
  10141   "RTN","RCD PEMAP",40, 0)
  10142    D:$P(INPU T,"^",8)=1  INFO^RCDP EM6            ; Disp lay captur e informat ion for Ex cel
  10143   "RTN","RCD PEMAP",41, 0)
  10144    S $P(INPU T,"^",9)=$ $DEVICE($P (INPUT,"^" ,8),.IO)     ; Ask ou tput devic e
  10145   "RTN","RCD PEMAP",42, 0)
  10146    Q:'$P(INP UT,"^",9)
  10147   "RTN","RCD PEMAP",43, 0)
  10148    ;
  10149   "RTN","RCD PEMAP",44, 0)
  10150    ; Option  to queue
  10151   "RTN","RCD PEMAP",45, 0)
  10152    I $D(IO(" Q")) D  Q
  10153   "RTN","RCD PEMAP",46, 0)
  10154    . N JOB S  JOB=$J
  10155   "RTN","RCD PEMAP",47, 0)
  10156    . N ZTDES C,ZTRTN,ZT SAVE,ZTSK
  10157   "RTN","RCD PEMAP",48, 0)
  10158    . S ZTRTN ="REPORT^R CDPEMAP(IN PUT,.RCVAU TD,.IO,JOB )"
  10159   "RTN","RCD PEMAP",49, 0)
  10160    . S ZTDES C="EEOBS M ARKED FOR  AUTO-POST  AUDIT REPO RT"
  10161   "RTN","RCD PEMAP",50, 0)
  10162    . M RCPYR SEL=^TMP(" RCSELPAY", $J)
  10163   "RTN","RCD PEMAP",51, 0)
  10164    . S ZTSAV E("RC*")=" ",ZTSAVE(" VAUTD")="" ,ZTSAVE("I O*")=""
  10165   "RTN","RCD PEMAP",52, 0)
  10166    . S ZTSAV E("INPUT") ="",ZTSAVE ("JOB")=""
  10167   "RTN","RCD PEMAP",53, 0)
  10168    . S ZTSAV E("^TMP("" RCDPEU1"", $J,")=""
  10169   "RTN","RCD PEMAP",54, 0)
  10170    . D ^%ZTL OAD
  10171   "RTN","RCD PEMAP",55, 0)
  10172    . W !!,$S ($D(ZTSK): "Task numb er "_ZTSK_ " was queu ed.",1:"Un able to qu eue this t ask.")
  10173   "RTN","RCD PEMAP",56, 0)
  10174    . K ZTSK, IO("Q")
  10175   "RTN","RCD PEMAP",57, 0)
  10176    . D HOME^ %ZIS
  10177   "RTN","RCD PEMAP",58, 0)
  10178    ;
  10179   "RTN","RCD PEMAP",59, 0)
  10180    D REPORT( INPUT,.RCV AUTD,.IO)                 ; Comp ile and Di splay Repo rt data
  10181   "RTN","RCD PEMAP",60, 0)
  10182    Q
  10183   "RTN","RCD PEMAP",61, 0)
  10184    ;
  10185   "RTN","RCD PEMAP",62, 0)
  10186   LMOUT(INPU T,RCVAUTD, IO) ; Outp ut report  to Listman
  10187   "RTN","RCD PEMAP",63, 0)
  10188    ; Input:    INPUT        - See  REPORT for  a complet e descript ion
  10189   "RTN","RCD PEMAP",64, 0)
  10190    ;           RCVAUTD      -  Arr ay of sele cted Divis ions
  10191   "RTN","RCD PEMAP",65, 0)
  10192    ;                           Onl y passed i f A1=2
  10193   "RTN","RCD PEMAP",66, 0)
  10194    ; Output:   ^TMP("RC DPE_MAP",$ J,CTR)=Lin e - Array  of display  lines (no  headers)
  10195   "RTN","RCD PEMAP",67, 0)
  10196    ;                                              for ou tput to Li stman
  10197   "RTN","RCD PEMAP",68, 0)
  10198    N HDR,RCT EMP
  10199   "RTN","RCD PEMAP",69, 0)
  10200    S $P(INPU T,"^",10)= 0                         ; Init ial listma n line cou nter
  10201   "RTN","RCD PEMAP",70, 0)
  10202    D REPORT( INPUT,.RCV AUTD,.IO)                 ; Get  the lines  to be disp layed
  10203   "RTN","RCD PEMAP",71, 0)
  10204    S HDR("TI TLE")="EEO Bs MARKED  FOR AP AUD IT"
  10205   "RTN","RCD PEMAP",72, 0)
  10206    S HDR(1)= $$HDRLN2^R CDPEMA1(IN PUT)
  10207   "RTN","RCD PEMAP",73, 0)
  10208    S HDR(2)= $$HDRLN3^R CDPEMA1(IN PUT)
  10209   "RTN","RCD PEMAP",74, 0)
  10210    S HDR(3)= $$HDRLN4^R CDPEMA1(IN PUT)
  10211   "RTN","RCD PEMAP",75, 0)
  10212    S HDR(4)= "ERA #        Claim #      Trace  #"
  10213   "RTN","RCD PEMAP",76, 0)
  10214    S RCTEMP= "RCDPE EEO B MARKED F OR AP AUDI T"
  10215   "RTN","RCD PEMAP",77, 0)
  10216    D LMRPT^R CDPEARL(.H DR,$NA(^TM P("RCDPE_M AP",$J)),R CTEMP) ; G enerate Li stMan disp lay
  10217   "RTN","RCD PEMAP",78, 0)
  10218    ;
  10219   "RTN","RCD PEMAP",79, 0)
  10220    D ^%ZISC                                       ; Clos e the devi ce
  10221   "RTN","RCD PEMAP",80, 0)
  10222    K ^TMP("R CDPE_MAP", $J),^TMP($ J,"RCDPE_M AP")
  10223   "RTN","RCD PEMAP",81, 0)
  10224    K ^TMP("R CSELPAY",$ J),^TMP($J ,"SELPAYER "),^TMP($J ,"SELUSER" )
  10225   "RTN","RCD PEMAP",82, 0)
  10226    Q
  10227   "RTN","RCD PEMAP",83, 0)
  10228    ;
  10229   "RTN","RCD PEMAP",84, 0)
  10230   STADIV(RCV AUTD) ; Di vision/Sta tion Filte r
  10231   "RTN","RCD PEMAP",85, 0)
  10232    ; Input:    None
  10233   "RTN","RCD PEMAP",86, 0)
  10234    ; Output:   RCVAUTD      - Arra y of selec ted divisi ons, if 1  is returne d
  10235   "RTN","RCD PEMAP",87, 0)
  10236    ; Returns : 0            - User  up-arrowe d or timed  out
  10237   "RTN","RCD PEMAP",88, 0)
  10238    ;           1            - All  divisions  selected
  10239   "RTN","RCD PEMAP",89, 0)
  10240    ;           2            - Sele cted Divis ions
  10241   "RTN","RCD PEMAP",90, 0)
  10242    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,VAUTD,X, Y
  10243   "RTN","RCD PEMAP",91, 0)
  10244    D DIVISIO N^VAUTOMA                            ; IA # 664 allows  this
  10245   "RTN","RCD PEMAP",92, 0)
  10246    Q:Y<0 0                                        ; User  up-arrowe d or timed  out
  10247   "RTN","RCD PEMAP",93, 0)
  10248    Q:VAUTD=1  1                                   ; All  divisions  selected
  10249   "RTN","RCD PEMAP",94, 0)
  10250    M RCVAUTD =VAUTD                               ; Save  selected  divisions  (if any)
  10251   "RTN","RCD PEMAP",95, 0)
  10252    Q 2
  10253   "RTN","RCD PEMAP",96, 0)
  10254    ;
  10255   "RTN","RCD PEMAP",97, 0)
  10256   SELUSER()  ; Ask the  user if th ey only wa nt to all  users or o nly select ed ones
  10257   "RTN","RCD PEMAP",98, 0)
  10258    ; Input:    None
  10259   "RTN","RCD PEMAP",99, 0)
  10260    ; Returns : 0 - User  up-arrowe d or timed  out
  10261   "RTN","RCD PEMAP",100 ,0)
  10262    ;           1 - Show  all users
  10263   "RTN","RCD PEMAP",101 ,0)
  10264    ;           2 - Show  selected  user
  10265   "RTN","RCD PEMAP",102 ,0)
  10266    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
  10267   "RTN","RCD PEMAP",103 ,0)
  10268    S DIR("A" )="Run Rep ort for (S )pecific o r (A)ll Us ers: "
  10269   "RTN","RCD PEMAP",104 ,0)
  10270    S DIR(0)= "SA^S:Spec ific;A:All "
  10271   "RTN","RCD PEMAP",105 ,0)
  10272    S DIR("?" ,1)="Enter  'A' to sh ow EEOBs m arked by a ny user."
  10273   "RTN","RCD PEMAP",106 ,0)
  10274    S DIR("?" )="Enter ' S' to show  EEOBs mar ked by spe cific user (s)."
  10275   "RTN","RCD PEMAP",107 ,0)
  10276    S DIR("B" )="A"
  10277   "RTN","RCD PEMAP",108 ,0)
  10278    D ^DIR
  10279   "RTN","RCD PEMAP",109 ,0)
  10280    I $D(DTOU T)!$D(DUOU T)!(Y="")  Q -1
  10281   "RTN","RCD PEMAP",110 ,0)
  10282    Q:Y="A" 1
  10283   "RTN","RCD PEMAP",111 ,0)
  10284    Q 2
  10285   "RTN","RCD PEMAP",112 ,0)
  10286    ;
  10287   "RTN","RCD PEMAP",113 ,0)
  10288   SELUSER2(P ARAM) ; Al lows the u ser to ent er the sel ected user s to filte r by
  10289   "RTN","RCD PEMAP",114 ,0)
  10290    ; Input:    None
  10291   "RTN","RCD PEMAP",115 ,0)
  10292    ; Output:   ^TMP($J, "SELUSER", IEN)="" Wh ere IEN -  IEN for fi le 200
  10293   "RTN","RCD PEMAP",116 ,0)
  10294    ; Returns : 1 - Succ ess, -1 -  Abort
  10295   "RTN","RCD PEMAP",117 ,0)
  10296    N RCA,RET ,RETURN,QU IT
  10297   "RTN","RCD PEMAP",118 ,0)
  10298    K ^TMP($J ,"SELUSER" )
  10299   "RTN","RCD PEMAP",119 ,0)
  10300    S QUIT=0, RETURN=1
  10301   "RTN","RCD PEMAP",120 ,0)
  10302    F  D  Q:Q UIT
  10303   "RTN","RCD PEMAP",121 ,0)
  10304    . S RET=$ $ASKUSER()
  10305   "RTN","RCD PEMAP",122 ,0)
  10306    . I RET=- 1 S RETURN =-1,QUIT=1  Q
  10307   "RTN","RCD PEMAP",123 ,0)
  10308    . I RET=0  D
  10309   "RTN","RCD PEMAP",124 ,0)
  10310    . . I $D( ^TMP($J,"S ELUSER"))  S QUIT=1
  10311   "RTN","RCD PEMAP",125 ,0)
  10312    . . E  D
  10313   "RTN","RCD PEMAP",126 ,0)
  10314    . . . W ! !,"You mus t select a t least on e user",*7 ,!
  10315   "RTN","RCD PEMAP",127 ,0)
  10316    I RETURN= -1 K ^TMP( $J,"SELUSE R") Q -1
  10317   "RTN","RCD PEMAP",128 ,0)
  10318    S RETURN= $S($D(^TMP ($J,"SELUS ER")):1,1: -1)
  10319   "RTN","RCD PEMAP",129 ,0)
  10320    Q RETURN
  10321   "RTN","RCD PEMAP",130 ,0)
  10322    ;
  10323   "RTN","RCD PEMAP",131 ,0)
  10324   ASKUSER()  ; Prompt f or a User  from file  200
  10325   "RTN","RCD PEMAP",132 ,0)
  10326    ; Input:    None
  10327   "RTN","RCD PEMAP",133 ,0)
  10328    ; Output:   ^TMP($J, "SELUSER", IEN)="" -  Selected U ser
  10329   "RTN","RCD PEMAP",134 ,0)
  10330    ; Returns :  1 - Use r selected
  10331   "RTN","RCD PEMAP",135 ,0)
  10332    ;            0 - No  User selec ted
  10333   "RTN","RCD PEMAP",136 ,0)
  10334    ;           -1 - use r typed '^ ' or timed  out
  10335   "RTN","RCD PEMAP",137 ,0)
  10336    ;
  10337   "RTN","RCD PEMAP",138 ,0)
  10338    N DIC,DIR ,DIROUT,DI RUT,DTOUT, DUOUT,X,Y
  10339   "RTN","RCD PEMAP",139 ,0)
  10340    S RETURN= 1
  10341   "RTN","RCD PEMAP",140 ,0)
  10342    ;
  10343   "RTN","RCD PEMAP",141 ,0)
  10344    S DIC=200 ,DIC(0)="Q EA"
  10345   "RTN","RCD PEMAP",142 ,0)
  10346    S DIC("A" )="Select  User: "
  10347   "RTN","RCD PEMAP",143 ,0)
  10348    S DIC("S" )="I '$D(^ TMP($J,""S ELUSER"",Y ))"
  10349   "RTN","RCD PEMAP",144 ,0)
  10350    D ^DIC
  10351   "RTN","RCD PEMAP",145 ,0)
  10352    I $D(DTOU T)!$D(DUOU T) Q -1
  10353   "RTN","RCD PEMAP",146 ,0)
  10354    I Y=-1 Q  0
  10355   "RTN","RCD PEMAP",147 ,0)
  10356    S ^TMP($J ,"SELUSER" ,+Y)=""
  10357   "RTN","RCD PEMAP",148 ,0)
  10358    Q 1
  10359   "RTN","RCD PEMAP",149 ,0)
  10360    ;
  10361   "RTN","RCD PEMAP",150 ,0)
  10362   SECSORT()  ; Ask the  user if th ey want th e secondar y sort by  User or Pa yer Name
  10363   "RTN","RCD PEMAP",151 ,0)
  10364    ; Input:    None
  10365   "RTN","RCD PEMAP",152 ,0)
  10366    ; Returns : 0        - User up- arrowed or  timed out
  10367   "RTN","RCD PEMAP",153 ,0)
  10368    ;           1        - Sort by  User
  10369   "RTN","RCD PEMAP",154 ,0)
  10370    ;           2        - Sort by  Payer Name
  10371   "RTN","RCD PEMAP",155 ,0)
  10372    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
  10373   "RTN","RCD PEMAP",156 ,0)
  10374    S DIR("A" )="Sort by  Insurance  Company ( N)ame or ( U)ser: "
  10375   "RTN","RCD PEMAP",157 ,0)
  10376    S DIR(0)= "SA^N:Name ;U:User"
  10377   "RTN","RCD PEMAP",158 ,0)
  10378    S DIR("?" ,1)="Enter  'N' to so rt by Paye r Name."
  10379   "RTN","RCD PEMAP",159 ,0)
  10380    S DIR("?" )="Enter ' U' to sort  by user."
  10381   "RTN","RCD PEMAP",160 ,0)
  10382    S DIR("B" )="N"
  10383   "RTN","RCD PEMAP",161 ,0)
  10384    D ^DIR
  10385   "RTN","RCD PEMAP",162 ,0)
  10386    I $D(DTOU T)!$D(DUOU T)!(Y="")  Q -1
  10387   "RTN","RCD PEMAP",163 ,0)
  10388    Q:Y="U" 1
  10389   "RTN","RCD PEMAP",164 ,0)
  10390    Q 2
  10391   "RTN","RCD PEMAP",165 ,0)
  10392    ;
  10393   "RTN","RCD PEMAP",166 ,0)
  10394   DTRNG(WHIC H) ; Allow s the user  to select  the Auto- Post OR ER A Received
  10395   "RTN","RCD PEMAP",167 ,0)
  10396    ; date ra nge to be  used
  10397   "RTN","RCD PEMAP",168 ,0)
  10398    ; Input:    WHICH    - 0 - Auto -Post Date  Range
  10399   "RTN","RCD PEMAP",169 ,0)
  10400    ;                      1 - ERA  Date Recei ved Date R ange
  10401   "RTN","RCD PEMAP",170 ,0)
  10402    ; Returns : 0        - User up- arrowed or  timed out , 1 otherw ise
  10403   "RTN","RCD PEMAP",171 ,0)
  10404    ;           A1^A2    - Where:
  10405   "RTN","RCD PEMAP",172 ,0)
  10406    ;                      A1 - Aut -Post Star t Date
  10407   "RTN","RCD PEMAP",173 ,0)
  10408    ;                      A2 - Aut o-Post End  Date
  10409   "RTN","RCD PEMAP",174 ,0)
  10410    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,RANGE,ST ART,X,XX,Y
  10411   "RTN","RCD PEMAP",175 ,0)
  10412    S DIR(0)= "DA^:"_DT_ ":APE"
  10413   "RTN","RCD PEMAP",176 ,0)
  10414    S DIR("A" )="Start D ate: "
  10415   "RTN","RCD PEMAP",177 ,0)
  10416    S DIR("?" )="Enter t he earlies t Auto-Pos t date"
  10417   "RTN","RCD PEMAP",178 ,0)
  10418    D ^DIR
  10419   "RTN","RCD PEMAP",179 ,0)
  10420    Q:$D(DTOU T)!$D(DUOU T)!(Y="")  0
  10421   "RTN","RCD PEMAP",180 ,0)
  10422    S START=Y
  10423   "RTN","RCD PEMAP",181 ,0)
  10424   ENDDT ; Pr ompt for e nd date
  10425   "RTN","RCD PEMAP",182 ,0)
  10426    K DIR
  10427   "RTN","RCD PEMAP",183 ,0)
  10428    S DIR("B" )=Y(0)
  10429   "RTN","RCD PEMAP",184 ,0)
  10430    S DIR(0)= "DA^"_STAR T_":"_DT_" :APE"
  10431   "RTN","RCD PEMAP",185 ,0)
  10432    S DIR("A" )="End Dat e: "
  10433   "RTN","RCD PEMAP",186 ,0)
  10434    S DIR("?" )="Enter t he latest  Auto-Post  date"
  10435   "RTN","RCD PEMAP",187 ,0)
  10436    D ^DIR
  10437   "RTN","RCD PEMAP",188 ,0)
  10438    Q:$D(DTOU T)!$D(DUOU T)!(Y="")  0
  10439   "RTN","RCD PEMAP",189 ,0)
  10440    I Y<START  D  G ENDD T
  10441   "RTN","RCD PEMAP",190 ,0)
  10442    . S XX=$$ FMTE^XLFDT (START,"2Z D") ;****
  10443   "RTN","RCD PEMAP",191 ,0)
  10444    . W !,*7, "Enter an  End date t hat is not  less than  "_XX
  10445   "RTN","RCD PEMAP",192 ,0)
  10446    S RANGE=S TART_"|"_Y
  10447   "RTN","RCD PEMAP",193 ,0)
  10448    Q RANGE
  10449   "RTN","RCD PEMAP",194 ,0)
  10450    ;
  10451   "RTN","RCD PEMAP",195 ,0)
  10452   EXCEL() ;  Ask the us er if they  want to e xport to E xcel
  10453   "RTN","RCD PEMAP",196 ,0)
  10454    ; Input:    None
  10455   "RTN","RCD PEMAP",197 ,0)
  10456    ; Returns : -1       - User up- arrowed or  timed out
  10457   "RTN","RCD PEMAP",198 ,0)
  10458    ;            0       - Output t o paper
  10459   "RTN","RCD PEMAP",199 ,0)
  10460    ;            1       - Output t o Excel
  10461   "RTN","RCD PEMAP",200 ,0)
  10462    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
  10463   "RTN","RCD PEMAP",201 ,0)
  10464    S DIR(0)= "Y"
  10465   "RTN","RCD PEMAP",202 ,0)
  10466    S DIR("A" )="Export  the report  to Micros oft Excel"
  10467   "RTN","RCD PEMAP",203 ,0)
  10468    S DIR("B" )="NO"
  10469   "RTN","RCD PEMAP",204 ,0)
  10470    S DIR("?" )="Enter ' YES' to ou tput to Ex cel. Other wise enter  'NO'"
  10471   "RTN","RCD PEMAP",205 ,0)
  10472    D ^DIR
  10473   "RTN","RCD PEMAP",206 ,0)
  10474    I $G(DUOU T) Q -1
  10475   "RTN","RCD PEMAP",207 ,0)
  10476    Q Y
  10477   "RTN","RCD PEMAP",208 ,0)
  10478    ;
  10479   "RTN","RCD PEMAP",209 ,0)
  10480   DEVICE(EXC EL,IO) ; S elect the  output dev ice
  10481   "RTN","RCD PEMAP",210 ,0)
  10482    ; Input:    EXCEL    - 1 - Oupu t to Excel , 0 otherw ise
  10483   "RTN","RCD PEMAP",211 ,0)
  10484    ; Output:   %ZIS     - Selected  device
  10485   "RTN","RCD PEMAP",212 ,0)
  10486    ;           IO       - Array of  selected  output inf o
  10487   "RTN","RCD PEMAP",213 ,0)
  10488    ; Returns : 0        - No devic e selected , 1 otherw ise
  10489   "RTN","RCD PEMAP",214 ,0)
  10490    N POP,RCP YRSEL,%ZIS
  10491   "RTN","RCD PEMAP",215 ,0)
  10492    S %ZIS="Q M"
  10493   "RTN","RCD PEMAP",216 ,0)
  10494    D ^%ZIS
  10495   "RTN","RCD PEMAP",217 ,0)
  10496    Q:POP 0
  10497   "RTN","RCD PEMAP",218 ,0)
  10498    Q:EXCEL 1                    ;  Output to  Excel, no  queueing
  10499   "RTN","RCD PEMAP",219 ,0)
  10500    ;
  10501   "RTN","RCD PEMAP",220 ,0)
  10502    Q 1
  10503   "RTN","RCD PEMAP",221 ,0)
  10504    ;
  10505   "RTN","RCD PEMAP",222 ,0)
  10506   REPORT(INP UT,RCVAUTD ,IO,JOB) ;  Compile a nd run the  report
  10507   "RTN","RCD PEMAP",223 ,0)
  10508    ; Expects  ZTQUEUED  to be defi ned alread y if queue d
  10509   "RTN","RCD PEMAP",224 ,0)
  10510    ; Input:    INPUT    - A1^A2^A3 ^...^An Wh ere:
  10511   "RTN","RCD PEMAP",225 ,0)
  10512    ;                         A1 -  1 - All di visions se lected
  10513   "RTN","RCD PEMAP",226 ,0)
  10514    ;                               2 - Select ed divisio ns
  10515   "RTN","RCD PEMAP",227 ,0)
  10516    ;                         A2 -  B1|B2   -  Where:
  10517   "RTN","RCD PEMAP",228 ,0)
  10518    ;                                B1 - Auto -Post Star t Date
  10519   "RTN","RCD PEMAP",229 ,0)
  10520    ;                                B2 - Auto -Post End  Date
  10521   "RTN","RCD PEMAP",230 ,0)
  10522    ;                         A3 -  'M' - Medi cal Payers  only
  10523   "RTN","RCD PEMAP",231 ,0)
  10524    ;                               'P' - Phar macy Payer s only
  10525   "RTN","RCD PEMAP",232 ,0)
  10526    ;                               'T' - Tric are Payers  onlye
  10527   "RTN","RCD PEMAP",233 ,0)
  10528    ;                               'A' - All  Payers
  10529   "RTN","RCD PEMAP",234 ,0)
  10530    ;                         A4 -  'S' - Spec ific Payer s
  10531   "RTN","RCD PEMAP",235 ,0)
  10532    ;                               'R' - Rang e of Payer s
  10533   "RTN","RCD PEMAP",236 ,0)
  10534    ;                               'A' - All  Payers
  10535   "RTN","RCD PEMAP",237 ,0)
  10536    ;                         A5 -  1 - Displa y all user s
  10537   "RTN","RCD PEMAP",238 ,0)
  10538    ;                               2 - Displa y selected  users
  10539   "RTN","RCD PEMAP",239 ,0)
  10540    ;                         A6 -  1 - Sort b y User
  10541   "RTN","RCD PEMAP",240 ,0)
  10542    ;                               2 - Sort b y Payer Na me
  10543   "RTN","RCD PEMAP",241 ,0)
  10544    ;                         A7 -  0 - Do not  display i n a listma n template
  10545   "RTN","RCD PEMAP",242 ,0)
  10546    ;                               1 - Displa y in a lis tman templ ate
  10547   "RTN","RCD PEMAP",243 ,0)
  10548    ;                         A8 -  0 - Output  to paper
  10549   "RTN","RCD PEMAP",244 ,0)
  10550    ;                               1 - Output  to Excel
  10551   "RTN","RCD PEMAP",245 ,0)
  10552    ;                         A9 -  Line count er for Lis tman outpu t
  10553   "RTN","RCD PEMAP",246 ,0)
  10554    ;            RCVAUTD  -  Array  of selecte d Division s
  10555   "RTN","RCD PEMAP",247 ,0)
  10556    ;                        Only p assed if A 1=2
  10557   "RTN","RCD PEMAP",248 ,0)
  10558    ;            IO       - Interfa ce device
  10559   "RTN","RCD PEMAP",249 ,0)
  10560    ;            JOB      - $J (opt ional, onl y passed i n when rep ort is que ued)
  10561   "RTN","RCD PEMAP",250 ,0)
  10562    ;            ^TMP($J ,"RCSELPAY ") - Globa l Array of  selected  insurance  companies
  10563   "RTN","RCD PEMAP",251 ,0)
  10564    ;            ^TMP($J ,"SELUSER" )  - Globa l Array of  selected  users
  10565   "RTN","RCD PEMAP",252 ,0)
  10566    ; Output:    ^TMP("R CDPEMAP",$ J,CTR)=Lin e - Array  of display  lines (no  headers)
  10567   "RTN","RCD PEMAP",253 ,0)
  10568    ;                                              for ou tput to Li stman
  10569   "RTN","RCD PEMAP",254 ,0)
  10570    ;                                              Only s et when A7 -1
  10571   "RTN","RCD PEMAP",255 ,0)
  10572    N CURDT,D IVFLT,DTEN D,DTSTART, IENS,IEN34 44,IEN3444 1,PAYER,PA YERU
  10573   "RTN","RCD PEMAP",256 ,0)
  10574    N RCTYPE, RCPAYS,SOR T,TIN,UIEN ,USER,USER U,USERF,SV AL,XX,YY,Z Z
  10575   "RTN","RCD PEMAP",257 ,0)
  10576    K ^TMP("R CDPE_MAP", $J),^TMP($ J,"RCDPE_M AP")
  10577   "RTN","RCD PEMAP",258 ,0)
  10578    ; I '$G(J OB) S JOB= ""
  10579   "RTN","RCD PEMAP",259 ,0)
  10580    U IO
  10581   "RTN","RCD PEMAP",260 ,0)
  10582    S DIVFLT= $P(INPUT," ^",1)                     ; Divi sion filte r
  10583   "RTN","RCD PEMAP",261 ,0)
  10584    S SORT=$P (INPUT,"^" ,6)                       ; Type  of second ary sort
  10585   "RTN","RCD PEMAP",262 ,0)
  10586    S DTEND=$ P($P(INPUT ,"^",2),"| ",2)_".999 9"  ; End  of Date Ra nge
  10587   "RTN","RCD PEMAP",263 ,0)
  10588    S DTSTART =$P($P(INP UT,"^",2), "|",1)         ; End  of Date Ra nge
  10589   "RTN","RCD PEMAP",264 ,0)
  10590    S RCTYPE= $P(INPUT," ^",3)                     ; Medi cal/Pharma cy/Tricare /All
  10591   "RTN","RCD PEMAP",265 ,0)
  10592    S RCPAYS= $P(INPUT," ^",4)                     ; Paye rs All/Sel ected/Rang e
  10593   "RTN","RCD PEMAP",266 ,0)
  10594    S USERF=$ P(INPUT,"^ ",5)                      ; All  Users/Sele cted Users
  10595   "RTN","RCD PEMAP",267 ,0)
  10596    ;
  10597   "RTN","RCD PEMAP",268 ,0)
  10598    ; First f ilter and  sort the r eport
  10599   "RTN","RCD PEMAP",269 ,0)
  10600    S CURDT=( DTSTART-1) _.9999
  10601   "RTN","RCD PEMAP",270 ,0)
  10602    F  D  Q:' CURDT  Q:C URDT>(DTEN D)
  10603   "RTN","RCD PEMAP",271 ,0)
  10604    . S CURDT =$O(^RCY(3 44.4,"F",C URDT))
  10605   "RTN","RCD PEMAP",272 ,0)
  10606    . Q:'CURD T
  10607   "RTN","RCD PEMAP",273 ,0)
  10608    . Q:CURDT >(DTEND)
  10609   "RTN","RCD PEMAP",274 ,0)
  10610    . S IEN34 44=0
  10611   "RTN","RCD PEMAP",275 ,0)
  10612    . F  D  Q :'IEN3444
  10613   "RTN","RCD PEMAP",276 ,0)
  10614    . . S IEN 3444=$O(^R CY(344.4," F",CURDT,I EN3444))
  10615   "RTN","RCD PEMAP",277 ,0)
  10616    . . Q:'IE N3444
  10617   "RTN","RCD PEMAP",278 ,0)
  10618    . . I DIV FLT'=1 Q:' $$CHKDIV^R CDPEDAR(IE N3444,1,.R CVAUTD)  ;  Not a sel ected Divi sion
  10619   "RTN","RCD PEMAP",279 ,0)
  10620    . . S PAY ER=$$GET1^ DIQ(344.4, IEN3444,.0 6,"I")              ;  Payment F rom field
  10621   "RTN","RCD PEMAP",280 ,0)
  10622    . . S TIN =$$GET1^DI Q(344.4,IE N3444,.03, "I")                ;  Insurance  Co Id
  10623   "RTN","RCD PEMAP",281 ,0)
  10624    . . S PAY ERU=$$UP^X LFSTR(PAYE R)
  10625   "RTN","RCD PEMAP",282 ,0)
  10626    . . S PAY ER=TIN_"/" _$E(PAYER, 1,70-$L(TI N))
  10627   "RTN","RCD PEMAP",283 ,0)
  10628    . . S XX= 1
  10629   "RTN","RCD PEMAP",284 ,0)
  10630    . . I RCP AYS'="A" D   Q:'XX
  10631   "RTN","RCD PEMAP",285 ,0)
  10632    . . . S X X=$$ISSEL^ RCDPEU1(34 4.4,IEN344 4)               ; Ch eck if pay er was sel ected
  10633   "RTN","RCD PEMAP",286 ,0)
  10634    . . E  I  RCTYPE'="A " D  Q:'XX                             ; If  all of a  give type  of payer s elected
  10635   "RTN","RCD PEMAP",287 ,0)
  10636    . . . S X X=$$ISTYPE ^RCDPEU1(3 44.4,IEN34 44,RCTYPE)       ; Ch eck that p ayer match es type
  10637   "RTN","RCD PEMAP",288 ,0)
  10638    . . S IEN 34441=""
  10639   "RTN","RCD PEMAP",289 ,0)
  10640    . . F  D   Q:IEN3444 1=""
  10641   "RTN","RCD PEMAP",290 ,0)
  10642    . . . S I EN34441=$O (^RCY(344. 4,"F",CURD T,IEN3444, IEN34441))
  10643   "RTN","RCD PEMAP",291 ,0)
  10644    . . . Q:I EN34441=""
  10645   "RTN","RCD PEMAP",292 ,0)
  10646    . . . S I ENS=IEN344 41_","_IEN 3444_","
  10647   "RTN","RCD PEMAP",293 ,0)
  10648    . . . S U IEN=$$GET1 ^DIQ(344.4 1,IENS,6.0 1,"I")           ; ER A Detail l ine Marked  Auto-Post  User
  10649   "RTN","RCD PEMAP",294 ,0)
  10650    . . . Q:U IEN=""                                            ; No t marked f or Auto-Po st
  10651   "RTN","RCD PEMAP",295 ,0)
  10652    . . . S U SER=$$GET1 ^DIQ(200,U IEN_",",.0 1,"E")
  10653   "RTN","RCD PEMAP",296 ,0)
  10654    . . . S U SERU=$$UP^ XLFSTR(USE R)
  10655   "RTN","RCD PEMAP",297 ,0)
  10656    . . . I U SERF'=1,'$ D(^TMP($J, "SELUSER", UIEN)) Q         ; No t a select ed User
  10657   "RTN","RCD PEMAP",298 ,0)
  10658    . . . S S VAL=$S(SOR T=2:PAYERU ,1:USERU)                   ; Ge t the sort  value
  10659   "RTN","RCD PEMAP",299 ,0)
  10660    . . . S X X=PAYER_"^ "_USER
  10661   "RTN","RCD PEMAP",300 ,0)
  10662    . . . S $ P(XX,"^",3 )=$$GET1^D IQ(344.4,I EN3444_"," ,.01,"E")_ "."_IEN344 41 ; ERA#_ "."_SEQ
  10663   "RTN","RCD PEMAP",301 ,0)
  10664    . . . S Y Y=$$GET1^D IQ(344.41, IENS,.02," I")                   ; IEN for  361.1
  10665   "RTN","RCD PEMAP",302 ,0)
  10666    . . . S Z Z=$$GET1^D IQ(361.1,Y Y_",",.01, "I")                  ; IEN for  399/430
  10667   "RTN","RCD PEMAP",303 ,0)
  10668    . . . S Z Z=$$GET1^D IQ(430,ZZ_ ",",.01,"E ")                    ; Claim #
  10669   "RTN","RCD PEMAP",304 ,0)
  10670    . . . S Z Z=$TR(ZZ," -","")
  10671   "RTN","RCD PEMAP",305 ,0)
  10672    . . . S $ P(XX,"^",4 )=ZZ
  10673   "RTN","RCD PEMAP",306 ,0)
  10674    . . . S $ P(XX,"^",5 )=$$GET1^D IQ(361.1,Y Y_",",.07, "E")       ; Trace #
  10675   "RTN","RCD PEMAP",307 ,0)
  10676    . . . ;
  10677   "RTN","RCD PEMAP",308 ,0)
  10678    . . . ; F ound one t hat was ma rked for a uto-post
  10679   "RTN","RCD PEMAP",309 ,0)
  10680    . . . S ^ TMP($J,"RC DPE_MAP"," SEL",CURDT )=$$FMTE^X LFDT(CURDT ,"2ZD")
  10681   "RTN","RCD PEMAP",310 ,0)
  10682    . . . S ^ TMP($J,"RC DPE_MAP"," SEL",CURDT ,SVAL)=$S( SORT=2:PAY ER,1:USER)
  10683   "RTN","RCD PEMAP",311 ,0)
  10684    . . . S ^ TMP($J,"RC DPE_MAP"," SEL",CURDT ,SVAL,IEN3 444,IEN344 41)=XX
  10685   "RTN","RCD PEMAP",312 ,0)
  10686    ;
  10687   "RTN","RCD PEMAP",313 ,0)
  10688    D RPTOUT^ RCDPEMA1(I NPUT)                     ; Outp ut the rep ort
  10689   "RTN","RCD PEMAP",314 ,0)
  10690    ;
  10691   "RTN","RCD PEMAP",315 ,0)
  10692    ; Quit if  Listman -  clean up  of ^TMP &  device is  handled in  LMOUT^RCD PELAR
  10693   "RTN","RCD PEMAP",316 ,0)
  10694    Q:$P(INPU T,"^",7)=1
  10695   "RTN","RCD PEMAP",317 ,0)
  10696    ;
  10697   "RTN","RCD PEMAP",318 ,0)
  10698    ; Close d evice
  10699   "RTN","RCD PEMAP",319 ,0)
  10700    I '$D(ZTQ UEUED) D ^ %ZISC
  10701   "RTN","RCD PEMAP",320 ,0)
  10702    I $D(ZTQU EUED) S ZT REQ="@"
  10703   "RTN","RCD PEMAP",321 ,0)
  10704    K ^TMP("R CDPE_MAP", $J),^TMP($ J,"RCDPE_M AP")
  10705   "RTN","RCD PEMAP",322 ,0)
  10706    K ^TMP("R CSELPAY",$ J),^TMP($J ,"SELPAYER "),^TMP($J ,"SELUSER" )
  10707   "RTN","RCD PEMAP",323 ,0)
  10708    K ^TMP("R CDPEU1",$J )
  10709   "RTN","RCD PEMAP",324 ,0)
  10710    K ZTQUEUE D
  10711   "RTN","RCD PEMAP",325 ,0)
  10712    Q
  10713   "RTN","RCD PEMAP",326 ,0)
  10714    ;
  10715   "RTN","RCD PEMAP",327 ,0)
  10716   ASKSTOP()  ;EP from R CDPEMA1
  10717   "RTN","RCD PEMAP",328 ,0)
  10718    ; Ask to  continue
  10719   "RTN","RCD PEMAP",329 ,0)
  10720    ; Input:    IOST     - Device T ype 
  10721   "RTN","RCD PEMAP",330 ,0)
  10722    ; Returns : 1 - User  wants to  quit, 0 ot herwise
  10723   "RTN","RCD PEMAP",331 ,0)
  10724    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
  10725   "RTN","RCD PEMAP",332 ,0)
  10726    Q:$E(IOST ,1,2)'["C- " 0                       ; Not  a terminal
  10727   "RTN","RCD PEMAP",333 ,0)
  10728    S DIR(0)= "E"
  10729   "RTN","RCD PEMAP",334 ,0)
  10730    W ! D ^DI R
  10731   "RTN","RCD PEMAP",335 ,0)
  10732    I ($D(DIR UT))!($D(D UOUT)) Q 1
  10733   "RTN","RCD PEMAP",336 ,0)
  10734    Q 0
  10735   "RTN","RCD PEMAP",337 ,0)
  10736    ;
  10737   "RTN","RCD PENR3")
  10738   0^13^B2106 52613
  10739   "RTN","RCD PENR3",1,0 )
  10740   RCDPENR3 ; ALB/SAB -  EPay Natio nal Report s - ERA/EF T Trending  Report, p art 2 ;20  Aug 2018 1 3:01:41
  10741   "RTN","RCD PENR3",2,0 )
  10742    ;;4.5;Acc ounts Rece ivable;**3 04,321,326 ,332**;Mar  20, 1995; Build 34
  10743   "RTN","RCD PENR3",3,0 )
  10744    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  10745   "RTN","RCD PENR3",4,0 )
  10746    ;
  10747   "RTN","RCD PENR3",5,0 )
  10748    ;Read ^DG CR(399) vi a Private  IA 3820
  10749   "RTN","RCD PENR3",6,0 )
  10750    ;Read ^DG (40.8) via  Controlle d IA 417
  10751   "RTN","RCD PENR3",7,0 )
  10752    ;Read ^IB M(361.1) v ia Private  IA 4051
  10753   "RTN","RCD PENR3",8,0 )
  10754    ;Use DIV^ IBJDF2 via  Private I A 3130
  10755   "RTN","RCD PENR3",9,0 )
  10756    ;
  10757   "RTN","RCD PENR3",10, 0)
  10758    Q
  10759   "RTN","RCD PENR3",11, 0)
  10760    ;
  10761   "RTN","RCD PENR3",12, 0)
  10762    ;
  10763   "RTN","RCD PENR3",13, 0)
  10764    ;Generate  the neede d statisti cs for the  report
  10765   "RTN","RCD PENR3",14, 0)
  10766   COMPILE ;
  10767   "RTN","RCD PENR3",15, 0)
  10768    ;
  10769   "RTN","RCD PENR3",16, 0)
  10770    ;RCERATYP  values 1= "ERA/EFT"   2="ERA/PA PER CHECK"   3="PAPER  EOB/EFT"
  10771   "RTN","RCD PENR3",17, 0)
  10772    ;     nee ded for th e correct  report sor t order
  10773   "RTN","RCD PENR3",18, 0)
  10774    N I,RCINS TIN,RCERAT YP,RCCLAIM ,RCDATA,RC DAYS,RCEFT PD,RCEPDT, RCERAIEN,R CERANUM,RC EFTIEN  ;  Looping va riable
  10775   "RTN","RCD PENR3",19, 0)
  10776    N RCGPDAT A,RCGPCT,R CGPBILL,RC GPPD,RCGPB ECT,RCGPBE DY,RCGPEEC T,RCGPEEDY ,RCGPEPCT, RCGPEPDY,R CGPBPCT,RC GPBPDY,RCG PECT,RCGPE NM,RCGPFCT ,RCGPFPD   ; Grand To tal W/Paym ent method  variables  
  10777   "RTN","RCD PENR3",20, 0)
  10778    N RCPPDAT A,RCPPCT,R CPPBILL,RC PPPD,RCPPB ECT,RCPPBE DY,RCPPEEC T,RCPPEEDY ,RCPPEPCT, RCPPEPDY,R CPPBPCT,RC PPBPDY,RCP PECT,RCPPE NM,RCPPFCT ,RCPPFPD   ; Payer W/ Payment me thod varia bles 
  10779   "RTN","RCD PENR3",21, 0)
  10780    ;
  10781   "RTN","RCD PENR3",22, 0)
  10782    ;Initiali ze all val id ERA/EFT  combinati ons to rep ort on.
  10783   "RTN","RCD PENR3",23, 0)
  10784    ; init gr and total
  10785   "RTN","RCD PENR3",24, 0)
  10786    F I=1:1:3  I '$D(^TM P("RCDPENR 2",$J,"GTO T",I)) S ^ TMP("RCDPE NR2",$J,"G TOT",I)=0
  10787   "RTN","RCD PENR3",25, 0)
  10788    ;
  10789   "RTN","RCD PENR3",26, 0)
  10790    ; init in surance gr and totals
  10791   "RTN","RCD PENR3",27, 0)
  10792    S RCINSTI N=""
  10793   "RTN","RCD PENR3",28, 0)
  10794    F  S RCIN STIN=$O(^T MP("RCDPEN R2",$J,"PA YER",RCINS TIN)) Q:RC INSTIN=""   D
  10795   "RTN","RCD PENR3",29, 0)
  10796    . F I=1:1 :3 I '$D(^ TMP("RCDPE NR2",$J,"P AYER",RCIN STIN,I)) S  ^TMP("RCD PENR2",$J, "PAYER",RC INSTIN,I)= 0
  10797   "RTN","RCD PENR3",30, 0)
  10798    ;
  10799   "RTN","RCD PENR3",31, 0)
  10800    ; Compile  results
  10801   "RTN","RCD PENR3",32, 0)
  10802    S RCINSTI N=""
  10803   "RTN","RCD PENR3",33, 0)
  10804    F  S RCIN STIN=$O(^T MP("RCDPEN R2",$J,"MA IN",RCINST IN)) Q:RCI NSTIN=""   D
  10805   "RTN","RCD PENR3",34, 0)
  10806    . S RCERA TYP=""
  10807   "RTN","RCD PENR3",35, 0)
  10808    . F  S RC ERATYP=$O( ^TMP("RCDP ENR2",$J," MAIN",RCIN STIN,RCERA TYP)) Q:RC ERATYP=""   D
  10809   "RTN","RCD PENR3",36, 0)
  10810    . . S RCC LAIM=""
  10811   "RTN","RCD PENR3",37, 0)
  10812    . . F  S  RCCLAIM=$O (^TMP("RCD PENR2",$J, "MAIN",RCI NSTIN,RCER ATYP,RCCLA IM)) Q:RCC LAIM=""  D
  10813   "RTN","RCD PENR3",38, 0)
  10814    . . . S R CDATA=$G(^ TMP("RCDPE NR2",$J,"M AIN",RCINS TIN,RCERAT YP,RCCLAIM ))
  10815   "RTN","RCD PENR3",39, 0)
  10816    . . . Q:R CDATA=""
  10817   "RTN","RCD PENR3",40, 0)
  10818    . . . ;
  10819   "RTN","RCD PENR3",41, 0)
  10820    . . . ; E xtract the  Grand Tot al by EFT/ ERA type
  10821   "RTN","RCD PENR3",42, 0)
  10822    . . . S R CGPDATA=$G (^TMP("RCD PENR2",$J, "GTOT",RCE RATYP))
  10823   "RTN","RCD PENR3",43, 0)
  10824    . . . S R CGPCT=$P(R CGPDATA,U)
  10825   "RTN","RCD PENR3",44, 0)
  10826    . . . S R CGPBILL=$P (RCGPDATA, U,2)
  10827   "RTN","RCD PENR3",45, 0)
  10828    . . . S R CGPPD=$P(R CGPDATA,U, 3)
  10829   "RTN","RCD PENR3",46, 0)
  10830    . . . S R CGPBECT=$P (RCGPDATA, U,4)
  10831   "RTN","RCD PENR3",47, 0)
  10832    . . . S R CGPBEDY=$P (RCGPDATA, U,5)
  10833   "RTN","RCD PENR3",48, 0)
  10834    . . . S R CGPEECT=$P (RCGPDATA, U,6)
  10835   "RTN","RCD PENR3",49, 0)
  10836    . . . S R CGPEEDY=$P (RCGPDATA, U,7)
  10837   "RTN","RCD PENR3",50, 0)
  10838    . . . S R CGPEPCT=$P (RCGPDATA, U,8)
  10839   "RTN","RCD PENR3",51, 0)
  10840    . . . S R CGPEPDY=$P (RCGPDATA, U,9)
  10841   "RTN","RCD PENR3",52, 0)
  10842    . . . S R CGPBPCT=$P (RCGPDATA, U,10)
  10843   "RTN","RCD PENR3",53, 0)
  10844    . . . S R CGPBPDY=$P (RCGPDATA, U,11)
  10845   "RTN","RCD PENR3",54, 0)
  10846    . . . S R CGPECT=$P( RCGPDATA,U ,12)
  10847   "RTN","RCD PENR3",55, 0)
  10848    . . . S R CGPENM=$P( RCGPDATA,U ,13)
  10849   "RTN","RCD PENR3",56, 0)
  10850    . . . S R CGPFCT=$P( RCGPDATA,U ,14)
  10851   "RTN","RCD PENR3",57, 0)
  10852    . . . S R CGPFPD=$P( RCGPDATA,U ,15)
  10853   "RTN","RCD PENR3",58, 0)
  10854    . . . ;
  10855   "RTN","RCD PENR3",59, 0)
  10856    . . . ; E xtract the  Payer spe cific info rmation by  EFT/ERA t ype
  10857   "RTN","RCD PENR3",60, 0)
  10858    . . . S R CPPDATA=$G (^TMP("RCD PENR2",$J, "PAYER",RC INSTIN,RCE RATYP))
  10859   "RTN","RCD PENR3",61, 0)
  10860    . . . S R CPPCT=$P(R CPPDATA,U)
  10861   "RTN","RCD PENR3",62, 0)
  10862    . . . S R CPPBILL=$P (RCPPDATA, U,2)
  10863   "RTN","RCD PENR3",63, 0)
  10864    . . . S R CPPPD=$P(R CPPDATA,U, 3)
  10865   "RTN","RCD PENR3",64, 0)
  10866    . . . S R CPPBECT=$P (RCPPDATA, U,4)
  10867   "RTN","RCD PENR3",65, 0)
  10868    . . . S R CPPBEDY=$P (RCPPDATA, U,5)
  10869   "RTN","RCD PENR3",66, 0)
  10870    . . . S R CPPEECT=$P (RCPPDATA, U,6)
  10871   "RTN","RCD PENR3",67, 0)
  10872    . . . S R CPPEEDY=$P (RCPPDATA, U,7)
  10873   "RTN","RCD PENR3",68, 0)
  10874    . . . S R CPPEPCT=$P (RCPPDATA, U,8)
  10875   "RTN","RCD PENR3",69, 0)
  10876    . . . S R CPPEPDY=$P (RCPPDATA, U,9)
  10877   "RTN","RCD PENR3",70, 0)
  10878    . . . S R CPPBPCT=$P (RCPPDATA, U,10)
  10879   "RTN","RCD PENR3",71, 0)
  10880    . . . S R CPPBPDY=$P (RCPPDATA, U,11)
  10881   "RTN","RCD PENR3",72, 0)
  10882    . . . S R CPPECT=$P( RCPPDATA,U ,12)
  10883   "RTN","RCD PENR3",73, 0)
  10884    . . . S R CPPENM=$P( RCPPDATA,U ,13)
  10885   "RTN","RCD PENR3",74, 0)
  10886    . . . S R CPPFCT=$P( RCPPDATA,U ,14)
  10887   "RTN","RCD PENR3",75, 0)
  10888    . . . S R CPPFPD=$P( RCPPDATA,U ,15)
  10889   "RTN","RCD PENR3",76, 0)
  10890    . . . ;
  10891   "RTN","RCD PENR3",77, 0)
  10892    . . . ; T otal count s - Grand/ Payment Me thod
  10893   "RTN","RCD PENR3",78, 0)
  10894    . . . S R CGPCT=RCGP CT+1
  10895   "RTN","RCD PENR3",79, 0)
  10896    . . . S R CGPBILL=RC GPBILL+$P( RCDATA,U,6 )
  10897   "RTN","RCD PENR3",80, 0)
  10898    . . . S R CGPPD=RCGP PD+$P(RCDA TA,U,7)
  10899   "RTN","RCD PENR3",81, 0)
  10900    . . . ;
  10901   "RTN","RCD PENR3",82, 0)
  10902    . . . ; T otal count s - Payer/ Payment me thod
  10903   "RTN","RCD PENR3",83, 0)
  10904    . . . S R CPPCT=RCPP CT+1
  10905   "RTN","RCD PENR3",84, 0)
  10906    . . . S R CPPBILL=RC PPBILL+$P( RCDATA,U,6 )
  10907   "RTN","RCD PENR3",85, 0)
  10908    . . . S R CPPPD=RCPP PD+$P(RCDA TA,U,7)
  10909   "RTN","RCD PENR3",86, 0)
  10910    . . . ;
  10911   "RTN","RCD PENR3",87, 0)
  10912    . . . ; B illed to E RA receive d
  10913   "RTN","RCD PENR3",88, 0)
  10914    . . . I $ P(RCDATA,U ,8),$P(RCD ATA,U,9) D
  10915   "RTN","RCD PENR3",89, 0)
  10916    . . . . S  RCGPBECT= RCGPBECT+1
  10917   "RTN","RCD PENR3",90, 0)
  10918    . . . . S  RCPPBECT= RCPPBECT+1
  10919   "RTN","RCD PENR3",91, 0)
  10920    . . . . S  RCDAYS=$$ FMDIFF^XLF DT($P(RCDA TA,U,9),$P (RCDATA,U, 8),1)
  10921   "RTN","RCD PENR3",92, 0)
  10922    . . . . S  RCGPBEDY= RCGPBEDY+R CDAYS
  10923   "RTN","RCD PENR3",93, 0)
  10924    . . . . S  RCPPBEDY= RCPPBEDY+R CDAYS
  10925   "RTN","RCD PENR3",94, 0)
  10926    . . . ;
  10927   "RTN","RCD PENR3",95, 0)
  10928    . . . ; E RA to EFT  received
  10929   "RTN","RCD PENR3",96, 0)
  10930    . . . I $ P(RCDATA,U ,10),$P(RC DATA,U,9)  D
  10931   "RTN","RCD PENR3",97, 0)
  10932    . . . . S  RCGPEECT= RCGPEECT+1
  10933   "RTN","RCD PENR3",98, 0)
  10934    . . . . S  RCPPEECT= RCPPEECT+1
  10935   "RTN","RCD PENR3",99, 0)
  10936    . . . . S  RCDAYS=$$ FMDIFF^XLF DT($P(RCDA TA,U,10),$ P(RCDATA,U ,9),1)
  10937   "RTN","RCD PENR3",100 ,0)
  10938    . . . . S  RCGPEEDY= RCGPEEDY+R CDAYS
  10939   "RTN","RCD PENR3",101 ,0)
  10940    . . . . S  RCPPEEDY= RCPPEEDY+R CDAYS
  10941   "RTN","RCD PENR3",102 ,0)
  10942    . . . ;
  10943   "RTN","RCD PENR3",103 ,0)
  10944    . . . ; E RA and EFT  received,  and payme nt Posted
  10945   "RTN","RCD PENR3",104 ,0)
  10946    . . . I $ P(RCDATA,U ,10),$P(RC DATA,U,9), $P(RCDATA, U,11) D
  10947   "RTN","RCD PENR3",105 ,0)
  10948    . . . . S  RCGPEPCT= RCGPEPCT+1
  10949   "RTN","RCD PENR3",106 ,0)
  10950    . . . . S  RCPPEPCT= RCPPEPCT+1
  10951   "RTN","RCD PENR3",107 ,0)
  10952    . . . . S  RCEPDT=$S ($P(RCDATA ,U,9)>$P(R CDATA,U,10 ):9,1:10)   ;determin e which da te is late r
  10953   "RTN","RCD PENR3",108 ,0)
  10954    . . . . S  RCDAYS=$$ FMDIFF^XLF DT($P(RCDA TA,U,11),$ P(RCDATA,U ,RCEPDT),1 )
  10955   "RTN","RCD PENR3",109 ,0)
  10956    . . . . S  RCGPEPDY= RCGPEPDY+R CDAYS
  10957   "RTN","RCD PENR3",110 ,0)
  10958    . . . . S  RCPPEPDY= RCPPEPDY+R CDAYS
  10959   "RTN","RCD PENR3",111 ,0)
  10960    . . . ;
  10961   "RTN","RCD PENR3",112 ,0)
  10962    . . . ; B ill to Pay ment Poste d
  10963   "RTN","RCD PENR3",113 ,0)
  10964    . . . I $ P(RCDATA,U ,8),$P(RCD ATA,U,11)  D
  10965   "RTN","RCD PENR3",114 ,0)
  10966    . . . . S  RCGPBPCT= RCGPBPCT+1
  10967   "RTN","RCD PENR3",115 ,0)
  10968    . . . . S  RCPPBPCT= RCPPBPCT+1
  10969   "RTN","RCD PENR3",116 ,0)
  10970    . . . . S  RCDAYS=$$ FMDIFF^XLF DT($P(RCDA TA,U,11),$ P(RCDATA,U ,8),1)
  10971   "RTN","RCD PENR3",117 ,0)
  10972    . . . . S  RCGPBPDY= RCGPBPDY+R CDAYS
  10973   "RTN","RCD PENR3",118 ,0)
  10974    . . . . S  RCPPBPDY= RCPPBPDY+R CDAYS
  10975   "RTN","RCD PENR3",119 ,0)
  10976    . . . ;
  10977   "RTN","RCD PENR3",120 ,0)
  10978    . . . ; I f the ERA  hasn't alr eady been  counted, a dd it to t he totals
  10979   "RTN","RCD PENR3",121 ,0)
  10980    . . . S R CERAIEN=$P (RCDATA,U, 2)
  10981   "RTN","RCD PENR3",122 ,0)
  10982    . . . I R CERAIEN,'$ D(^TMP("RC DPENR2",$J ,"ERA",RCE RAIEN)) D
  10983   "RTN","RCD PENR3",123 ,0)
  10984    . . . . S  ^TMP("RCD PENR2",$J, "ERA",RCER AIEN)=""
  10985   "RTN","RCD PENR3",124 ,0)
  10986    . . . . S  RCERANUM= $P(RCDATA, U,15)
  10987   "RTN","RCD PENR3",125 ,0)
  10988    . . . . S  RCGPECT=R CGPECT+1,R CPPECT=RCP PECT+1
  10989   "RTN","RCD PENR3",126 ,0)
  10990    . . . . S  RCGPENM=R CGPENM+RCE RANUM,RCPP ENM=RCPPEN M+RCERANUM
  10991   "RTN","RCD PENR3",127 ,0)
  10992    . . . ;
  10993   "RTN","RCD PENR3",128 ,0)
  10994    . . . ; I f the EFT  hasn't alr eady been  counted, a dd it to t he totals
  10995   "RTN","RCD PENR3",129 ,0)
  10996    . . . S R CEFTIEN=$P (RCDATA,U, 3)
  10997   "RTN","RCD PENR3",130 ,0)
  10998    . . . I ( RCEFTIEN), ('$D(^TMP( "RCDPENR2" ,$J,"EFT", RCEFTIEN)) ) D
  10999   "RTN","RCD PENR3",131 ,0)
  11000    . . . . S  ^TMP("RCD PENR2",$J, "EFT",RCEF TIEN)=""
  11001   "RTN","RCD PENR3",132 ,0)
  11002    . . . . S  RCEFTPD=$ P(RCDATA,U ,18)
  11003   "RTN","RCD PENR3",133 ,0)
  11004    . . . . S  RCGPFCT=R CGPFCT+1,R CPPFCT=RCP PFCT+1
  11005   "RTN","RCD PENR3",134 ,0)
  11006    . . . . S  RCGPFPD=R CGPFPD+RCE FTPD,RCPPF PD=RCPPFPD +RCEFTPD
  11007   "RTN","RCD PENR3",135 ,0)
  11008    . . . ;
  11009   "RTN","RCD PENR3",136 ,0)
  11010    . . . ; U pdate the  payer spec ific infor mation By  Payment Me thod
  11011   "RTN","RCD PENR3",137 ,0)
  11012    . . . S $ P(RCPPDATA ,U)=RCPPCT
  11013   "RTN","RCD PENR3",138 ,0)
  11014    . . . S $ P(RCPPDATA ,U,2)=RCPP BILL
  11015   "RTN","RCD PENR3",139 ,0)
  11016    . . . S $ P(RCPPDATA ,U,3)=RCPP PD
  11017   "RTN","RCD PENR3",140 ,0)
  11018    . . . S $ P(RCPPDATA ,U,4)=RCPP BECT
  11019   "RTN","RCD PENR3",141 ,0)
  11020    . . . S $ P(RCPPDATA ,U,5)=RCPP BEDY
  11021   "RTN","RCD PENR3",142 ,0)
  11022    . . . S $ P(RCPPDATA ,U,6)=RCPP EECT
  11023   "RTN","RCD PENR3",143 ,0)
  11024    . . . S $ P(RCPPDATA ,U,7)=RCPP EEDY
  11025   "RTN","RCD PENR3",144 ,0)
  11026    . . . S $ P(RCPPDATA ,U,8)=RCPP EPCT
  11027   "RTN","RCD PENR3",145 ,0)
  11028    . . . S $ P(RCPPDATA ,U,9)=RCPP EPDY
  11029   "RTN","RCD PENR3",146 ,0)
  11030    . . . S $ P(RCPPDATA ,U,10)=RCP PBPCT
  11031   "RTN","RCD PENR3",147 ,0)
  11032    . . . S $ P(RCPPDATA ,U,11)=RCP PBPDY
  11033   "RTN","RCD PENR3",148 ,0)
  11034    . . . S $ P(RCPPDATA ,U,12)=RCP PECT
  11035   "RTN","RCD PENR3",149 ,0)
  11036    . . . S $ P(RCPPDATA ,U,13)=RCP PENM
  11037   "RTN","RCD PENR3",150 ,0)
  11038    . . . S $ P(RCPPDATA ,U,14)=RCP PFCT
  11039   "RTN","RCD PENR3",151 ,0)
  11040    . . . S $ P(RCPPDATA ,U,15)=RCP PFPD
  11041   "RTN","RCD PENR3",152 ,0)
  11042    . . . S ^ TMP("RCDPE NR2",$J,"P AYER",RCIN STIN,RCERA TYP)=RCPPD ATA
  11043   "RTN","RCD PENR3",153 ,0)
  11044    . . . ;
  11045   "RTN","RCD PENR3",154 ,0)
  11046    . . . ; U pdate the  Grand Tota l specific  informati on By Paym ent Method
  11047   "RTN","RCD PENR3",155 ,0)
  11048    . . . S $ P(RCGPDATA ,U)=RCGPCT
  11049   "RTN","RCD PENR3",156 ,0)
  11050    . . . S $ P(RCGPDATA ,U,2)=RCGP BILL
  11051   "RTN","RCD PENR3",157 ,0)
  11052    . . . S $ P(RCGPDATA ,U,3)=RCGP PD
  11053   "RTN","RCD PENR3",158 ,0)
  11054    . . . S $ P(RCGPDATA ,U,4)=RCGP BECT
  11055   "RTN","RCD PENR3",159 ,0)
  11056    . . . S $ P(RCGPDATA ,U,5)=RCGP BEDY
  11057   "RTN","RCD PENR3",160 ,0)
  11058    . . . S $ P(RCGPDATA ,U,6)=RCGP EECT
  11059   "RTN","RCD PENR3",161 ,0)
  11060    . . . S $ P(RCGPDATA ,U,7)=RCGP EEDY
  11061   "RTN","RCD PENR3",162 ,0)
  11062    . . . S $ P(RCGPDATA ,U,8)=RCGP EPCT
  11063   "RTN","RCD PENR3",163 ,0)
  11064    . . . S $ P(RCGPDATA ,U,9)=RCGP EPDY
  11065   "RTN","RCD PENR3",164 ,0)
  11066    . . . S $ P(RCGPDATA ,U,10)=RCG PBPCT
  11067   "RTN","RCD PENR3",165 ,0)
  11068    . . . S $ P(RCGPDATA ,U,11)=RCG PBPDY
  11069   "RTN","RCD PENR3",166 ,0)
  11070    . . . S $ P(RCGPDATA ,U,12)=RCG PECT
  11071   "RTN","RCD PENR3",167 ,0)
  11072    . . . S $ P(RCGPDATA ,U,13)=RCG PENM
  11073   "RTN","RCD PENR3",168 ,0)
  11074    . . . S $ P(RCGPDATA ,U,14)=RCG PFCT
  11075   "RTN","RCD PENR3",169 ,0)
  11076    . . . S $ P(RCGPDATA ,U,15)=RCG PFPD
  11077   "RTN","RCD PENR3",170 ,0)
  11078    . . . S ^ TMP("RCDPE NR2",$J,"G TOT",RCERA TYP)=RCGPD ATA
  11079   "RTN","RCD PENR3",171 ,0)
  11080    Q
  11081   "RTN","RCD PENR3",172 ,0)
  11082    ;
  11083   "RTN","RCD PENR3",173 ,0)
  11084    ;Retrieve  all neces sary infor mation for  the EFTs  sent durin g the requ ested peri od.
  11085   "RTN","RCD PENR3",174 ,0)
  11086   GETEFT(RCS DATE,RCEDA TE,RCRATE)  ;
  11087   "RTN","RCD PENR3",175 ,0)
  11088    ;RCSDATE  - Start da te of extr action
  11089   "RTN","RCD PENR3",176 ,0)
  11090    ;RCEDATE  - End date  of extrac tion
  11091   "RTN","RCD PENR3",177 ,0)
  11092    ;
  11093   "RTN","RCD PENR3",178 ,0)
  11094    ;^TMP("RC DPENR2",$J ,"MAIN",IE N of Claim /Bill #) =
  11095   "RTN","RCD PENR3",179 ,0)
  11096    ; Where:
  11097   "RTN","RCD PENR3",180 ,0)
  11098    ; Piece   Variable
  11099   "RTN","RCD PENR3",181 ,0)
  11100    ; 1       RCBILL   -  IEN of Bi ll/Claim #
  11101   "RTN","RCD PENR3",182 ,0)
  11102    ; 2       RCERA    -  IEN of th e ERA the  bill was p aid on.
  11103   "RTN","RCD PENR3",183 ,0)
  11104    ; 3       RCIEN    -  IEN of th e EFT the  money for  the bill a rrived on
  11105   "RTN","RCD PENR3",184 ,0)
  11106    ; 4       RCEOB    -  IEN of th e EOB with in the ERA  
  11107   "RTN","RCD PENR3",185 ,0)
  11108    ; 5       RCDOS    -  Date of S ervice
  11109   "RTN","RCD PENR3",186 ,0)
  11110    ; 6       RCAMTBL  -  Amount Bi lled
  11111   "RTN","RCD PENR3",187 ,0)
  11112    ; 7       RCAMTPD  -  Amount Pa id
  11113   "RTN","RCD PENR3",188 ,0)
  11114    ; 8       RCDTBILL -  Date of B ill
  11115   "RTN","RCD PENR3",189 ,0)
  11116    ; 9       RCERARCD -  Date ERA  received
  11117   "RTN","RCD PENR3",190 ,0)
  11118    ; 10      RCEFTRCD -  Date EFT  received
  11119   "RTN","RCD PENR3",191 ,0)
  11120    ; 11      RCPOSTED -  Date Paym ent Posted  to claim
  11121   "RTN","RCD PENR3",192 ,0)
  11122    ; 12      RCTRACE  -  ERA Trace  number fo r EOB
  11123   "RTN","RCD PENR3",193 ,0)
  11124    ; 13      RCMETHOD -  Method of  Payment t ransmittal
  11125   "RTN","RCD PENR3",194 ,0)
  11126    ; 14      RCTRNTYP -  Was payme nt EFT or  Paper Chec k / Was th e ERA Pape r or EDI L ockbox
  11127   "RTN","RCD PENR3",195 ,0)
  11128    ; 15      RCERANUM -  # EOB'S i n ERA
  11129   "RTN","RCD PENR3",196 ,0)
  11130    ; 16      RCDIV    -  Division  of the bil l
  11131   "RTN","RCD PENR3",197 ,0)
  11132    ; 17      RCINSTIN -  Insurance /Insurance  TIN
  11133   "RTN","RCD PENR3",198 ,0)
  11134    ; 18      RCEFTPD  -  Amount pa id as an E FT, not as  a check.
  11135   "RTN","RCD PENR3",199 ,0)
  11136    ;
  11137   "RTN","RCD PENR3",200 ,0)
  11138    N OKAY,RC LDATE,RCIN S,RCIEN,RC EFTDT,RCER A,RCEFT,RC RCPT,RCPOS TED,RCPAYT YP,RCERADT ,RCTRACE,R CERAIDX
  11139   "RTN","RCD PENR3",201 ,0)
  11140    N RCTRLN, RCTRBD,RCE RANUM,RCTI N,RCPAYER, RCINSTIN,R CLPIEN,RCD TDATA,RCEO B,RCBILL,R CDIV,RCDOS ,RCAMTBL
  11141   "RTN","RCD PENR3",202 ,0)
  11142    N RCDTBIL L,RCMETHOD ,RCPAPER,R CEFTTYP,RC EFTPD,RCTR NTYP,RCDAT A,RCAMTPD, RCEFTRCD,R CERARCD,RC RATETP
  11143   "RTN","RCD PENR3",203 ,0)
  11144    N RCMSTAT ,RCESUMDT, RCPSUMDT,Z ZPNAME
  11145   "RTN","RCD PENR3",204 ,0)
  11146    ;
  11147   "RTN","RCD PENR3",205 ,0)
  11148    ;Get the  EFT Detail  informati on for the  report ba tches sent  within th e given da te range.
  11149   "RTN","RCD PENR3",206 ,0)
  11150    S RCLDATE =RCSDATE-. 001
  11151   "RTN","RCD PENR3",207 ,0)
  11152    F  S RCLD ATE=$O(^RC Y(344.31," ADR",RCLDA TE)) Q:RCL DATE=""  Q :RCLDATE>R CEDATE  D
  11153   "RTN","RCD PENR3",208 ,0)
  11154    . S RCIEN =0
  11155   "RTN","RCD PENR3",209 ,0)
  11156    . F  S RC IEN=$O(^RC Y(344.31," ADR",RCLDA TE,RCIEN))  Q:'RCIEN   D
  11157   "RTN","RCD PENR3",210 ,0)
  11158    . . S RCE FTDT=$G(^R CY(344.31, RCIEN,0))
  11159   "RTN","RCD PENR3",211 ,0)
  11160    . . Q:RCE FTDT=""
  11161   "RTN","RCD PENR3",212 ,0)
  11162    . . I RCP AY="A",RCT YPE'="A" D   Q:'OKAY   ; PRCA*4. 5*326 If a ll payers  included,  check by t ype
  11163   "RTN","RCD PENR3",213 ,0)
  11164    . . . S O KAY=$$ISTY PE^RCDPEU1 (344.31,RC IEN,RCTYPE )
  11165   "RTN","RCD PENR3",214 ,0)
  11166    . . ; Che ck Payer N ame
  11167   "RTN","RCD PENR3",215 ,0)
  11168    . . I RCP AY'="A" D   Q:'OKAY                 ; PRCA* 4.5*326 
  11169   "RTN","RCD PENR3",216 ,0)
  11170    . . . S O KAY=$$ISSE L^RCDPEU1( 344.31,RCI EN)
  11171   "RTN","RCD PENR3",217 ,0)
  11172    . . ;
  11173   "RTN","RCD PENR3",218 ,0)
  11174    . . S RCE RA=$P(RCEF TDT,U,10)              ; ERA IEN
  11175   "RTN","RCD PENR3",219 ,0)
  11176    . . S RCE FTRCD=$P(R CEFTDT,U,1 3)
  11177   "RTN","RCD PENR3",220 ,0)
  11178    . . S RCE FT=$P(RCEF TDT,U)
  11179   "RTN","RCD PENR3",221 ,0)
  11180    . . S ZZP NAME=$P(RC EFTDT,U,2)
  11181   "RTN","RCD PENR3",222 ,0)
  11182    . . S RCM STAT=$P(RC EFTDT,U,8)
  11183   "RTN","RCD PENR3",223 ,0)
  11184    . . S RCR CPT=$P(RCE FTDT,U,9)
  11185   "RTN","RCD PENR3",224 ,0)
  11186    . . S RCE FTPD=$P(RC EFTDT,U,7)
  11187   "RTN","RCD PENR3",225 ,0)
  11188    . . S RCP OSTED=$$GE T1^DIQ(344 .3,RCEFT_" ,",.11,"I" )
  11189   "RTN","RCD PENR3",226 ,0)
  11190    . . S RCP AYTYP=$$GE T1^DIQ(344 ,RCRCPT_", ",.04,"I")
  11191   "RTN","RCD PENR3",227 ,0)
  11192    . . I RCE RA D  Q
  11193   "RTN","RCD PENR3",228 ,0)
  11194    . . . S R CERADT=$G( ^RCY(344.4 ,RCERA,0))  ; ERA Dat a extracte d
  11195   "RTN","RCD PENR3",229 ,0)
  11196    . . . Q:' RCERADT
  11197   "RTN","RCD PENR3",230 ,0)
  11198    . . . S R CTRACE=$P( RCERADT,U, 2)          ; Trace #
  11199   "RTN","RCD PENR3",231 ,0)
  11200    . . . S R CTRLN=$L(R CTRACE),RC TRBD=$S(RC TRLN<11:1, 1:RCTRLN-9 )
  11201   "RTN","RCD PENR3",232 ,0)
  11202    . . . S R CTRACE=$E( RCTRACE,RC TRBD,RCTRL N)  ; get  the last 1 0 digits o f Trace #
  11203   "RTN","RCD PENR3",233 ,0)
  11204    . . . S R CERARCD=$P ($P(RCERAD T,U,7),"." ,1)  ;get  the date o f the ERA
  11205   "RTN","RCD PENR3",234 ,0)
  11206    . . . S R CERANUM=$P (RCERADT,U ,11)
  11207   "RTN","RCD PENR3",235 ,0)
  11208    . . . S R CTIN=$P(RC ERADT,U,3)
  11209   "RTN","RCD PENR3",236 ,0)
  11210    . . . S R CINS=$P(RC ERADT,U,6)
  11211   "RTN","RCD PENR3",237 ,0)
  11212    . . . S R CPAYER=$$G ETARPYR^RC DPENR2(RCT IN,ZZPNAME ) ; find t he AR Paye r IEN
  11213   "RTN","RCD PENR3",238 ,0)
  11214    . . . ; Q :'RCPAYER                    ; Q uit if Pay er/TIN not  found
  11215   "RTN","RCD PENR3",239 ,0)
  11216    . . . ; Q :'$$INSCHK ^RCDPENR2( RCPAYER)     ; Payer  is not in  the includ ed list fo r the repo rt
  11217   "RTN","RCD PENR3",240 ,0)
  11218    . . . S R CINSTIN=RC INS_"/"_RC TIN
  11219   "RTN","RCD PENR3",241 ,0)
  11220    . . . S R CLPIEN=0
  11221   "RTN","RCD PENR3",242 ,0)
  11222    . . . F   S RCLPIEN= $O(^RCY(34 4.4,RCERA, 1,RCLPIEN) ) Q:'RCLPI EN  D
  11223   "RTN","RCD PENR3",243 ,0)
  11224    . . . . S  RCDTDATA= $G(^RCY(34 4.4,RCERA, 1,RCLPIEN, 0))
  11225   "RTN","RCD PENR3",244 ,0)
  11226    . . . . S  RCEOB=$P( RCDTDATA,U ,2)
  11227   "RTN","RCD PENR3",245 ,0)
  11228    . . . . S  RCBILL=$$ BILLIEN^RC DPENR1(RCE OB)
  11229   "RTN","RCD PENR3",246 ,0)
  11230    . . . . Q :RCBILL=""    ; no bi lling info rmation
  11231   "RTN","RCD PENR3",247 ,0)
  11232    . . . . Q :$D(^TMP(" RCDPENR2", $J,"MAIN", RCBILL))   ;already c aptured.
  11233   "RTN","RCD PENR3",248 ,0)
  11234    . . . . S  RCDIV=$$D IV^IBJDF2( RCBILL)
  11235   "RTN","RCD PENR3",249 ,0)
  11236    . . . . S  RCDIV=$$G ET1^DIQ(40 .8,RCDIV_" ,",".01"," E")
  11237   "RTN","RCD PENR3",250 ,0)
  11238    . . . . ;
  11239   "RTN","RCD PENR3",251 ,0)
  11240    . . . . S  RCRATETP= $$GET1^DIQ (399,RCBIL L_",",.07, "I")
  11241   "RTN","RCD PENR3",252 ,0)
  11242    . . . . Q :RCRATETP' =RCRATE
  11243   "RTN","RCD PENR3",253 ,0)
  11244    . . . . ;  Quit if u ser specif ied a spec ific divis ion and bi ll is not  in that Di vision
  11245   "RTN","RCD PENR3",254 ,0)
  11246    . . . . I  '$D(^TMP( "RCDPENR2" ,$J,"DIVAL L"))&'$D(^ TMP("RCDPE NR2",$J,"D IV",RCDIV) ) Q 
  11247   "RTN","RCD PENR3",255 ,0)
  11248    . . . . S  RCDOS=$$G ET1^DIQ(39 9,RCBILL_" ,",.03,"I" )
  11249   "RTN","RCD PENR3",256 ,0)
  11250    . . . . S  RCAMTBL=$ $GET1^DIQ( 361.1,RCEO B_",",2.04 ,"I")
  11251   "RTN","RCD PENR3",257 ,0)
  11252    . . . . S  RCAMTPD=$ $GET1^DIQ( 361.1,RCEO B_",",1.01 ,"I")
  11253   "RTN","RCD PENR3",258 ,0)
  11254    . . . . S  RCDTBILL= $$GET1^DIQ (399,RCBIL L_",",12," I")
  11255   "RTN","RCD PENR3",259 ,0)
  11256    . . . . Q :RCDTBILL= ""   ;cant  calculate  if date f irst print ed is NULL
  11257   "RTN","RCD PENR3",260 ,0)
  11258    . . . . ;
  11259   "RTN","RCD PENR3",261 ,0)
  11260    . . . . S  RCMETHOD= $S($$GET1^ DIQ(344,RC ERA_",",4. 02,"I")="" :"MANUAL", 1:"AUTOPOS T")
  11261   "RTN","RCD PENR3",262 ,0)
  11262    . . . . S  RCPAPER=$ P($G(^RCY( 344.4,RCER A,20)),U,3 )  ; Paper  EOB ERA?
  11263   "RTN","RCD PENR3",263 ,0)
  11264    . . . . ; ERA not a  paper ERA,  is the EO B a Paper  EOB
  11265   "RTN","RCD PENR3",264 ,0)
  11266    . . . . S :'RCPAPER  RCPAPER=$S ($$GET1^DI Q(361.1,RC EOB_",",.1 7,"I")=0:" ERA",1:"PA PER")
  11267   "RTN","RCD PENR3",265 ,0)
  11268    . . . . S  RCEFTTYP= $S(RCPAYTY P=4:"PAPER ",1:"EFT")
  11269   "RTN","RCD PENR3",266 ,0)
  11270    . . . . S  RCTRNTYP= RCPAPER_"/ "_RCEFTTYP
  11271   "RTN","RCD PENR3",267 ,0)
  11272    . . . . S  RCERAIDX= $S(RCTRNTY P="ERA/EFT ":1,RCTRNT YP="ERA/PA PER":2,RCT RNTYP="PAP ER/EFT":3, 1:4)
  11273   "RTN","RCD PENR3",268 ,0)
  11274    . . . . Q :RCERAIDX= 4   ;Paper  Check Pap er EOB not  supported
  11275   "RTN","RCD PENR3",269 ,0)
  11276    . . . . S  RCDATA=RC BILL_U_RCE RA_U_RCIEN _U_RCEOB_U _RCDOS_U_R CAMTBL_U_R CAMTPD_U_R CDTBILL_U_ RCERARCD
  11277   "RTN","RCD PENR3",270 ,0)
  11278    . . . . S  RCDATA=RC DATA_U_RCE FTRCD_U_RC POSTED_U_R CTRACE_U_R CMETHOD_U
  11279   "RTN","RCD PENR3",271 ,0)
  11280    . . . . S  RCDATA=RC DATA_RCTRN TYP_U_RCER ANUM_U_RCD IV_U_RCINS TIN_U_RCEF TPD
  11281   "RTN","RCD PENR3",272 ,0)
  11282    . . . . S  ^TMP("RCD PENR2",$J, "MAIN",RCI NSTIN,RCER AIDX,RCBIL L)=RCDATA
  11283   "RTN","RCD PENR3",273 ,0)
  11284    . . I (RC MSTAT=2),( RCIEN),('$ D(^TMP("RC DPENR2",$J ,"EFT",RCI EN))) D
  11285   "RTN","RCD PENR3",274 ,0)
  11286    . . . S R CTIN=$P(RC EFTDT,U,3)
  11287   "RTN","RCD PENR3",275 ,0)
  11288    . . . S R CINS=$P(RC EFTDT,U,2)
  11289   "RTN","RCD PENR3",276 ,0)
  11290    . . . S R CPAYER=$$G ETARPYR^RC DPENR2(RCT IN,ZZPNAME ) ; find t he AR Paye r IEN
  11291   "RTN","RCD PENR3",277 ,0)
  11292    . . . ; Q :'RCPAYER                    ; Q uit if Pay er/TIN not  found
  11293   "RTN","RCD PENR3",278 ,0)
  11294    . . . ; Q :'$$INSCHK ^RCDPENR2( RCPAYER)     ; Payer  is not in  the includ ed list fo r the repo rt
  11295   "RTN","RCD PENR3",279 ,0)
  11296    . . . S R CINSTIN=RC INS_"/"_RC TIN
  11297   "RTN","RCD PENR3",280 ,0)
  11298    . . . S R CESUMDT=$G (^TMP("RCD PENR2",$J, "GTOT",3))
  11299   "RTN","RCD PENR3",281 ,0)
  11300    . . . S R CPSUMDT=$G (^TMP("RCD PENR2",$J, "PAYER",RC INSTIN,3))
  11301   "RTN","RCD PENR3",282 ,0)
  11302    . . . S $ P(RCESUMDT ,U,14)=$P( RCESUMDT,U ,14)+1
  11303   "RTN","RCD PENR3",283 ,0)
  11304    . . . S $ P(RCPSUMDT ,U,14)=$P( RCPSUMDT,U ,14)+1
  11305   "RTN","RCD PENR3",284 ,0)
  11306    . . . S $ P(RCESUMDT ,U,15)=$P( RCESUMDT,U ,15)+RCEFT PD
  11307   "RTN","RCD PENR3",285 ,0)
  11308    . . . S $ P(RCPSUMDT ,U,15)=$P( RCPSUMDT,U ,15)+RCEFT PD
  11309   "RTN","RCD PENR3",286 ,0)
  11310    . . . S ^ TMP("RCDPE NR2",$J,"G TOT",3)=RC ESUMDT
  11311   "RTN","RCD PENR3",287 ,0)
  11312    . . . S ^ TMP("RCDPE NR2",$J,"P AYER",RCIN STIN,3)=RC PSUMDT
  11313   "RTN","RCD PENR3",288 ,0)
  11314    Q
  11315   "RTN","RCD PENR3",289 ,0)
  11316    ;
  11317   "RTN","RCD PENR3",290 ,0)
  11318    ;Print th e Grand To tal/Summar y data for  the EFT/E RA Trendin g Report
  11319   "RTN","RCD PENR3",291 ,0)
  11320   PRINTGT(RC TITLE,RCDA TA,RCDISP, RCERAFLG,R CEXCEL) ;P RCA*4.5*33 2 - added  comments b elow, 20 A ugust 2018
  11321   "RTN","RCD PENR3",292 ,0)
  11322    ; Print t he Grand T otal/Summa ry data fo r the EFT/ ERA Trendi ng Report
  11323   "RTN","RCD PENR3",293 ,0)
  11324    ; Input:  RCTITLE -  Name of th e report
  11325   "RTN","RCD PENR3",294 ,0)
  11326    ; RCDATA  - Line of  compiled d ata being  processed
  11327   "RTN","RCD PENR3",295 ,0)
  11328    ; RCDISP  - 1 - Disp lay to scr een, 0 oth erwise 
  11329   "RTN","RCD PENR3",296 ,0)
  11330    ; RCERAFL G - 1 if w e're in th e ERA matc hed to an  EFT sectio n
  11331   "RTN","RCD PENR3",297 ,0)
  11332    ; 0 other wise
  11333   "RTN","RCD PENR3",298 ,0)
  11334    ; RCEXCEL  - 1 outpu t to excel , 0 otherw ise
  11335   "RTN","RCD PENR3",299 ,0)
  11336    ; RCSTOP  - Initiali zed to 0
  11337   "RTN","RCD PENR3",300 ,0)
  11338    ; Output:  RCSTOP -  User stopp ed the dis play of th e report
  11339   "RTN","RCD PENR3",301 ,0)
  11340    ;
  11341   "RTN","RCD PENR3",302 ,0)
  11342    ; Undecla red Parame ter(s) - R CRPIEN,RCL INE,RCSTOP
  11343   "RTN","RCD PENR3",303 ,0)
  11344    ; RCRPIEN  - IEN of  the archiv e file (34 4.91(
  11345   "RTN","RCD PENR3",304 ,0)
  11346    ; RCLINE  - String o f '-' to b e used as  a separato r line
  11347   "RTN","RCD PENR3",305 ,0)
  11348    ; RCSUMFL G - 'M' -  Main Repor t
  11349   "RTN","RCD PENR3",306 ,0)
  11350    ; 'G' - G rand total s
  11351   "RTN","RCD PENR3",307 ,0)
  11352    ; 'S' - S ummary
  11353   "RTN","RCD PENR3",308 ,0)
  11354    ;
  11355   "RTN","RCD PENR3",309 ,0)
  11356    ;PRCA*4.5 *332 comme nts end 
  11357   "RTN","RCD PENR3",310 ,0)
  11358    ;
  11359   "RTN","RCD PENR3",311 ,0)
  11360    N RCCOUNT ,RCBILL,RC PAID,RCPCT ,RCBECT,RC BEDY,RCAVG BE,RCEECT, RCEEDY
  11361   "RTN","RCD PENR3",312 ,0)
  11362    N RCEPCT, RCEPDY,RCA VGEP,RCBPC T,RCBPDY,R CAVGBP,RCB ORDER,RCSC DATA
  11363   "RTN","RCD PENR3",313 ,0)
  11364    N RCC,RCB ,RCAVGEE,R CLTXT,I,RC STRDTA,RCS TRNG,RCDTX T
  11365   "RTN","RCD PENR3",314 ,0)
  11366    ;
  11367   "RTN","RCD PENR3",315 ,0)
  11368    S RCERAFL G=+$G(RCER AFLG),RCDI SP=$G(RCDI SP)
  11369   "RTN","RCD PENR3",316 ,0)
  11370    I $Y>(IOS L-7),RCDIS P D ASK^RC DPEADP(.RC STOP,0) Q: RCSTOP  D  HEADER^RCD PENR2
  11371   "RTN","RCD PENR3",317 ,0)
  11372    ;
  11373   "RTN","RCD PENR3",318 ,0)
  11374    ; Display  report ty pe being d isplayed
  11375   "RTN","RCD PENR3",319 ,0)
  11376    D PRINTHD R^RCDPENR2 (RCTITLE)
  11377   "RTN","RCD PENR3",320 ,0)
  11378    ;
  11379   "RTN","RCD PENR3",321 ,0)
  11380    ; Extract  data from  string an d build st ring for o utput
  11381   "RTN","RCD PENR3",322 ,0)
  11382    S $P(RCSC DATA,U,1)= +$P(RCDATA ,U)
  11383   "RTN","RCD PENR3",323 ,0)
  11384    S RCBILL= +$P(RCDATA ,U,2)
  11385   "RTN","RCD PENR3",324 ,0)
  11386    S RCPAID= +$P(RCDATA ,U,3)
  11387   "RTN","RCD PENR3",325 ,0)
  11388    S $P(RCSC DATA,U,2)= RCBILL
  11389   "RTN","RCD PENR3",326 ,0)
  11390    S $P(RCSC DATA,U,3)= RCPAID
  11391   "RTN","RCD PENR3",327 ,0)
  11392    S $P(RCSC DATA,U,4)= $S(+RCBILL =0:0,1:RCP AID/RCBILL )*100  ; C onvert to  percent fo rmat
  11393   "RTN","RCD PENR3",328 ,0)
  11394    S RCBECT= +$P(RCDATA ,U,4)
  11395   "RTN","RCD PENR3",329 ,0)
  11396    S RCBEDY= +$P(RCDATA ,U,5)
  11397   "RTN","RCD PENR3",330 ,0)
  11398    S $P(RCSC DATA,U,6)= $FN($S(+RC BECT=0:0,1 :RCBEDY/RC BECT),"",0 )
  11399   "RTN","RCD PENR3",331 ,0)
  11400    S RCEECT= +$P(RCDATA ,U,6)
  11401   "RTN","RCD PENR3",332 ,0)
  11402    S RCEEDY= +$P(RCDATA ,U,7)
  11403   "RTN","RCD PENR3",333 ,0)
  11404    S $P(RCSC DATA,U,7)= $FN($S(+RC EECT=0:0,1 :RCEEDY/RC EECT),"",0 )
  11405   "RTN","RCD PENR3",334 ,0)
  11406    S RCEPCT= +$P(RCDATA ,U,8)
  11407   "RTN","RCD PENR3",335 ,0)
  11408    S RCEPDY= +$P(RCDATA ,U,9)
  11409   "RTN","RCD PENR3",336 ,0)
  11410    S $P(RCSC DATA,U,8)= $FN($S(+RC EPCT=0:0,1 :RCEPDY/RC EPCT),"",0 )
  11411   "RTN","RCD PENR3",337 ,0)
  11412    S RCBPCT= +$P(RCDATA ,U,10)
  11413   "RTN","RCD PENR3",338 ,0)
  11414    S RCBPDY= +$P(RCDATA ,U,11)
  11415   "RTN","RCD PENR3",339 ,0)
  11416    S $P(RCSC DATA,U,9)= $FN($S(+RC BPCT=0:0,1 :RCBPDY/RC BPCT),"",0 )
  11417   "RTN","RCD PENR3",340 ,0)
  11418    S $P(RCSC DATA,U,11) =+$P(RCDAT A,U,12)
  11419   "RTN","RCD PENR3",341 ,0)
  11420    S $P(RCSC DATA,U,12) =+$P(RCDAT A,U,13)
  11421   "RTN","RCD PENR3",342 ,0)
  11422    S $P(RCSC DATA,U,14) =+$P(RCDAT A,U,14)
  11423   "RTN","RCD PENR3",343 ,0)
  11424    S $P(RCSC DATA,U,15) =+$P(RCDAT A,U,15)
  11425   "RTN","RCD PENR3",344 ,0)
  11426    S $P(RCSC DATA,U,16) =RCPAID-$P (RCDATA,U, 15)
  11427   "RTN","RCD PENR3",345 ,0)
  11428    F I=1:1:1 6 D  Q:RCS TOP
  11429   "RTN","RCD PENR3",346 ,0)
  11430    . ; PRC*4 .5*332, ad ded (RCSUM FLG'="G")  below
  11431   "RTN","RCD PENR3",347 ,0)
  11432    . I (RCSU MFLG'="G") ,RCDISP,($ Y>(IOSL-4) ) D  Q:RCS TOP
  11433   "RTN","RCD PENR3",348 ,0)
  11434    . .  D AS K^RCDPEADP (.RCSTOP,0 )
  11435   "RTN","RCD PENR3",349 ,0)
  11436    . .  Q:RC STOP
  11437   "RTN","RCD PENR3",350 ,0)
  11438    . .  D HE ADER^RCDPE NR2
  11439   "RTN","RCD PENR3",351 ,0)
  11440    . ;if pri nting from  monthly b ackground  job save i n file and  quit
  11441   "RTN","RCD PENR3",352 ,0)
  11442    . ;Otherw ise print  to screen
  11443   "RTN","RCD PENR3",353 ,0)
  11444    . S (RCLT XT,RCDTXT) =$P($T(GDT XT+I),";;" ,2)
  11445   "RTN","RCD PENR3",354 ,0)
  11446    . I RCTIT LE["PAPER"  D
  11447   "RTN","RCD PENR3",355 ,0)
  11448    . . I (I> 5),(I<9) D       ; co rrect disp lay for li nes 6,7,8, 16
  11449   "RTN","RCD PENR3",356 ,0)
  11450    . . . I ( I=6),RCTIT LE["CHECK"  Q     ;Do nt change  line 6 if  Paper chec k section
  11451   "RTN","RCD PENR3",357 ,0)
  11452    . . . S R CB="EFT",R CC="CHK"   ; Correct  display fo r Paper ch eck sectio n
  11453   "RTN","RCD PENR3",358 ,0)
  11454    . . . I R CTITLE["EO B" S RCB=" ERA",RCC=" EOB"   ;co rrect disp lay for pa per eob
  11455   "RTN","RCD PENR3",359 ,0)
  11456    . . . S R CDTXT=$P(R CLTXT,RCB, 1)_RCC_$P( RCLTXT,RCB ,2)
  11457   "RTN","RCD PENR3",360 ,0)
  11458    . I 'RCDI SP!RCEXCEL  D  Q
  11459   "RTN","RCD PENR3",361 ,0)
  11460    . . S RCS TRDTA=$P(R CSCDATA,U, I)
  11461   "RTN","RCD PENR3",362 ,0)
  11462    . . ;Form at lines:  lines 2&3  are amount s, 4 is a  percentage , remainde r are inte gers.
  11463   "RTN","RCD PENR3",363 ,0)
  11464    . . S RCS TRNG=RCDTX T_"^"_$S(I =4:$J($P(R CSTRDTA,". "),2)_"%", 1:RCSTRDTA )
  11465   "RTN","RCD PENR3",364 ,0)
  11466    . . I 'RC DISP D SAV EDATA^RCDP ENR1(RCSTR NG,RCRPIEN ) Q
  11467   "RTN","RCD PENR3",365 ,0)
  11468    . .;if pr inting in  an EXCEL f ormat, pri nt "^" del imited and  quit
  11469   "RTN","RCD PENR3",366 ,0)
  11470    . . I RCE XCEL W RCS TRNG,! Q
  11471   "RTN","RCD PENR3",367 ,0)
  11472    . ;Output  to screen
  11473   "RTN","RCD PENR3",368 ,0)
  11474    . ;curren cy format
  11475   "RTN","RCD PENR3",369 ,0)
  11476    . I (I=2) !(I=3)!(I= 15) W RCDT XT,?65,$J( $P(RCSCDAT A,U,I),13, 2),! Q
  11477   "RTN","RCD PENR3",370 ,0)
  11478    . ; For t he line it ems that a re percent ages.  Not  using $J  formatting  due to ro unding err ors.
  11479   "RTN","RCD PENR3",371 ,0)
  11480    . I I=4 W  RCDTXT,?6 5,$J($P($P (RCSCDATA, U,I),"."), 12),"%",!  Q
  11481   "RTN","RCD PENR3",372 ,0)
  11482    . ;Otherw ise print  Number for mat
  11483   "RTN","RCD PENR3",373 ,0)
  11484    . I (I=16 ) D  Q
  11485   "RTN","RCD PENR3",374 ,0)
  11486    . . W:RCE RAFLG RCDT XT,?65,$J( $P(RCSCDAT A,U,I),13, 2),!
  11487   "RTN","RCD PENR3",375 ,0)
  11488    . W RCDTX T,?65,$J($ P(RCSCDATA ,U,I),13), !
  11489   "RTN","RCD PENR3",376 ,0)
  11490    I RCSTOP  Q RCSTOP
  11491   "RTN","RCD PENR3",377 ,0)
  11492    I RCDISP  W RCLINE,!  ;Otherwis e print Nu mber forma t
  11493   "RTN","RCD PENR3",378 ,0)
  11494    I 'RCDISP  D SAVEDAT A^RCDPENR1 (RCLINE,RC RPIEN)
  11495   "RTN","RCD PENR3",379 ,0)
  11496    Q RCSTOP
  11497   "RTN","RCD PENR3",380 ,0)
  11498    ;
  11499   "RTN","RCD PENR3",381 ,0)
  11500   GDTXT ;
  11501   "RTN","RCD PENR3",382 ,0)
  11502    ;;TOTAL N UMBER OF C LAIMS
  11503   "RTN","RCD PENR3",383 ,0)
  11504    ;;TOTAL A MOUNT BILL ED
  11505   "RTN","RCD PENR3",384 ,0)
  11506    ;;TOTAL A MOUNT PAID
  11507   "RTN","RCD PENR3",385 ,0)
  11508    ;;PERCENT AGE AMOUNT  PAID: (%T otal Paid/ Billed)
  11509   "RTN","RCD PENR3",386 ,0)
  11510    ;;
  11511   "RTN","RCD PENR3",387 ,0)
  11512    ;;AVG #DA YS BETWEEN  BILLED/ER A
  11513   "RTN","RCD PENR3",388 ,0)
  11514    ;;AVG #DA YS BETWEEN  ERA/EFT
  11515   "RTN","RCD PENR3",389 ,0)
  11516    ;;AVG #DA YS BETWEEN  ERA+EFT R EC'D/PMT P OSTED
  11517   "RTN","RCD PENR3",390 ,0)
  11518    ;;AVG #DA YS BETWEEN  BILLED/PM T POSTED
  11519   "RTN","RCD PENR3",391 ,0)
  11520    ;;
  11521   "RTN","RCD PENR3",392 ,0)
  11522    ;;TOTAL N UMBER OF E RAs
  11523   "RTN","RCD PENR3",393 ,0)
  11524    ;;TOTAL N UMBER OF E EOBs
  11525   "RTN","RCD PENR3",394 ,0)
  11526    ;;
  11527   "RTN","RCD PENR3",395 ,0)
  11528    ;;TOTAL N UMBER OF E FTs
  11529   "RTN","RCD PENR3",396 ,0)
  11530    ;;TOTAL A MOUNT COLL ECTED
  11531   "RTN","RCD PENR3",397 ,0)
  11532    ;;TOTAL D IFFERENCE  BETWEEN ER As (PAID)  - EFTs (CO LLECTED):
  11533   "RTN","RCD PENR3",398 ,0)
  11534    Q
  11535   "RTN","RCD PEP")
  11536   0^9^B15434 9379
  11537   "RTN","RCD PEP",1,0)
  11538   RCDPEP ;AI TC/CJE - F LAG PAYERS  AS PHARMA CY/TRICARE  ; 19-APR- 2017
  11539   "RTN","RCD PEP",2,0)
  11540    ;;4.5;Acc ounts Rece ivable;**3 21,326,332 **;;Build  34
  11541   "RTN","RCD PEP",3,0)
  11542    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  11543   "RTN","RCD PEP",4,0)
  11544    ;
  11545   "RTN","RCD PEP",5,0)
  11546   EN(FILTER, DATEFILT)  ; -- main  entry poin t for RCDP E PAYER FL AGS templa te
  11547   "RTN","RCD PEP",6,0)
  11548    ; Input:  FILTER - A =All payer s, P=Pharm acy payers , T=Tricar e payers,
  11549   "RTN","RCD PEP",7,0)
  11550    ; M=Medic al (Neithe r Pharmacy  nor Trica re)
  11551   "RTN","RCD PEP",8,0)
  11552    ; DATEFIL T - Additi onal Filte r by Date.  Has 3 pie ces by '^'
  11553   "RTN","RCD PEP",9,0)
  11554    ;             Piece  1 - 1=Filt er by date , 0=Don't
  11555   "RTN","RCD PEP",10,0)
  11556    ;             Piece  2 - START  - First DA TE ADDED t o include( FM format)
  11557   "RTN","RCD PEP",11,0)
  11558    ;             Piece  3 - END -  Last DATE  ADDED to i nclude (FM  format)
  11559   "RTN","RCD PEP",12,0)
  11560    ; 
  11561   "RTN","RCD PEP",13,0)
  11562    I '$D(DAT EFILT) S D ATEFILT=$$ GETDATE()
  11563   "RTN","RCD PEP",14,0)
  11564    I DATEFIL T=-1 Q  ;
  11565   "RTN","RCD PEP",15,0)
  11566    I '$D(FIL TER) S FIL TER=$$GETF ILT()
  11567   "RTN","RCD PEP",16,0)
  11568    I FILTER= -1 Q  ;
  11569   "RTN","RCD PEP",17,0)
  11570    ;
  11571   "RTN","RCD PEP",18,0)
  11572    D PAYEN^R CDPESP6 ;  PRCA*4.5*3 32
  11573   "RTN","RCD PEP",19,0)
  11574    D EN^VALM ("RCDPE PA YER FLAGS" )
  11575   "RTN","RCD PEP",20,0)
  11576    D PAYEX^R CDPESP6 ;  PRCA*4.5*3 32
  11577   "RTN","RCD PEP",21,0)
  11578    Q
  11579   "RTN","RCD PEP",22,0)
  11580    ;
  11581   "RTN","RCD PEP",23,0)
  11582   GETDATE()  ; Ask if t he user wa nts to fil ter by dat e. If so p rompt for  start
  11583   "RTN","RCD PEP",24,0)
  11584              ; and end  dates.
  11585   "RTN","RCD PEP",25,0)
  11586    ; Input:  None
  11587   "RTN","RCD PEP",26,0)
  11588    ; Output:  Return va lue=date f ilter para meters del imiter by  '^'
  11589   "RTN","RCD PEP",27,0)
  11590    ;          Piece 1 -  1=Filter  by date, 0 =Don't
  11591   "RTN","RCD PEP",28,0)
  11592    ;          Piece 2 -  START - F irst DATE  ADDED to i nclude(FM  format)
  11593   "RTN","RCD PEP",29,0)
  11594    ;          Piece 3 -  END - Las t DATE ADD ED to incl ude (FM fo rmat)
  11595   "RTN","RCD PEP",30,0)
  11596    ; 
  11597   "RTN","RCD PEP",31,0)
  11598    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,FD1,FD2, FILTER,OLD DATE,OD1,O D2,RETURN, X,XX,Y
  11599   "RTN","RCD PEP",32,0)
  11600    D FULL^VA LM1
  11601   "RTN","RCD PEP",33,0)
  11602    S VALMBCK ="R"
  11603   "RTN","RCD PEP",34,0)
  11604    S RETURN= "0"
  11605   "RTN","RCD PEP",35,0)
  11606    ;
  11607   "RTN","RCD PEP",36,0)
  11608    S XX=$P($ P($G(XQORN OD(0)),"^" ,4),"=",2)  ; User se lection wi th action
  11609   "RTN","RCD PEP",37,0)
  11610    S FD1=$P( XX,";",2), FD2=$P(XX, ";",3)
  11611   "RTN","RCD PEP",38,0)
  11612    ; See if  user selec tion is va lid (must  be T + or  - N days)
  11613   "RTN","RCD PEP",39,0)
  11614    S FD1=$$P ARSED(FD1)
  11615   "RTN","RCD PEP",40,0)
  11616    S FD2=$$P ARSED(FD2)
  11617   "RTN","RCD PEP",41,0)
  11618    I FD1,FD2  Q 1_"^"_F D1_"^"_FD2
  11619   "RTN","RCD PEP",42,0)
  11620    ;
  11621   "RTN","RCD PEP",43,0)
  11622    S OLDDATE =$G(DATEFI LT,0)
  11623   "RTN","RCD PEP",44,0)
  11624    S OD1=$P( OLDDATE,"^ ",2),OD2=$ P(OLDDATE, "^",3)
  11625   "RTN","RCD PEP",45,0)
  11626    ;
  11627   "RTN","RCD PEP",46,0)
  11628    S DIR(0)= "YA"
  11629   "RTN","RCD PEP",47,0)
  11630    S DIR("A" )="Filter  by Date Ad ded? "
  11631   "RTN","RCD PEP",48,0)
  11632    S DIR("B" )=$S(OLDDA TE:"YES",1 :"NO")
  11633   "RTN","RCD PEP",49,0)
  11634    S DIR("?" ,1)="Enter  'Y' or 'Y es' to fil ter the li st by DATE  ADDED"
  11635   "RTN","RCD PEP",50,0)
  11636    S DIR("?" )="Enter ' N' or 'No'  if you do  not wish  to filter  the list b y date"
  11637   "RTN","RCD PEP",51,0)
  11638    D ^DIR
  11639   "RTN","RCD PEP",52,0)
  11640    I $D(DIRU T) Q -1
  11641   "RTN","RCD PEP",53,0)
  11642    I Y=0 Q 0
  11643   "RTN","RCD PEP",54,0)
  11644    S RETURN= 1
  11645   "RTN","RCD PEP",55,0)
  11646    ;
  11647   "RTN","RCD PEP",56,0)
  11648    ; Prompt  for start  and end da te
  11649   "RTN","RCD PEP",57,0)
  11650    K DIR
  11651   "RTN","RCD PEP",58,0)
  11652    S DIR(0)= "DA^"
  11653   "RTN","RCD PEP",59,0)
  11654    S DIR("A" )="Filter  start date : "
  11655   "RTN","RCD PEP",60,0)
  11656    ; set def ault to ex isting fil ter start  date if it  is set.
  11657   "RTN","RCD PEP",61,0)
  11658    I OD1'=""  S DIR("B" )=$$FMTE^X LFDT(OD1," 2DZ")
  11659   "RTN","RCD PEP",62,0)
  11660    D ^DIR
  11661   "RTN","RCD PEP",63,0)
  11662    I $D(DIRU T) Q -1
  11663   "RTN","RCD PEP",64,0)
  11664    S (FD1,$P (RETURN,"^ ",2))=Y
  11665   "RTN","RCD PEP",65,0)
  11666    ;
  11667   "RTN","RCD PEP",66,0)
  11668    K DIR
  11669   "RTN","RCD PEP",67,0)
  11670    S DIR(0)= "DA^"_FD1_ ":"_DT
  11671   "RTN","RCD PEP",68,0)
  11672    S DIR("A" )="Filter  end date ( "
  11673   "RTN","RCD PEP",69,0)
  11674    S DIR("A" )=DIR("A") _$$FMTE^XL FDT(FD1,"2 DZ")_"-"
  11675   "RTN","RCD PEP",70,0)
  11676    S DIR("A" )=DIR("A") _$$FMTE^XL FDT(DT,"2D Z")_"): "
  11677   "RTN","RCD PEP",71,0)
  11678    ; Set def ault to ex isting fil ter end da te if it i s valid.
  11679   "RTN","RCD PEP",72,0)
  11680    ; (it mus t follow t he selecte d start da te). Other wise defau lt to toda y.
  11681   "RTN","RCD PEP",73,0)
  11682    I OD2'="" ,OD2'<FD1  S DIR("B") =$$FMTE^XL FDT(OD2,"2 DZ")
  11683   "RTN","RCD PEP",74,0)
  11684    I '$D(DIR ("B")) S D IR("B")="T "
  11685   "RTN","RCD PEP",75,0)
  11686    D ^DIR
  11687   "RTN","RCD PEP",76,0)
  11688    I $D(DIRU T) Q -1
  11689   "RTN","RCD PEP",77,0)
  11690    S (FD2,$P (RETURN,"^ ",3))=Y
  11691   "RTN","RCD PEP",78,0)
  11692    ;
  11693   "RTN","RCD PEP",79,0)
  11694    Q RETURN
  11695   "RTN","RCD PEP",80,0)
  11696    ;
  11697   "RTN","RCD PEP",81,0)
  11698   GETFILT()  ; Get filt er on paye r type
  11699   "RTN","RCD PEP",82,0)
  11700    ; Input:  None
  11701   "RTN","RCD PEP",83,0)
  11702    ; Return:  Filter ty pe.
  11703   "RTN","RCD PEP",84,0)
  11704    ;          A=All pay ers, P=Pha rmacy paye rs, T=Tric are payers ,
  11705   "RTN","RCD PEP",85,0)
  11706    ;          M=Medical  (Neither  Pharmacy n or Tricare )
  11707   "RTN","RCD PEP",86,0)
  11708    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,FILTER,X ,XX,Y
  11709   "RTN","RCD PEP",87,0)
  11710    ; Check f or value s pecified o n protocol
  11711   "RTN","RCD PEP",88,0)
  11712    S XX=$P($ P($G(XQORN OD(0)),"^" ,4),"=",2)  ; User se lection wi th action
  11713   "RTN","RCD PEP",89,0)
  11714    S XX=$E(X X)
  11715   "RTN","RCD PEP",90,0)
  11716    I XX'="", "APTM"[XX  Q XX
  11717   "RTN","RCD PEP",91,0)
  11718    ;
  11719   "RTN","RCD PEP",92,0)
  11720    S DIR(0)= "SA^A:All; P:Pharmacy  only;T:Tr icare only ;M:Medical "
  11721   "RTN","RCD PEP",93,0)
  11722    S DIR("A" )="Select  payers to  show. (A)l l, (P)harm acy, (T)ri care, (M)e dical: "
  11723   "RTN","RCD PEP",94,0)
  11724    S DIR("B" )="A"
  11725   "RTN","RCD PEP",95,0)
  11726    S DIR("?" ,1)="Selec t the type  of filter  to determ ine what p ayers will "
  11727   "RTN","RCD PEP",96,0)
  11728    S DIR("?" ,2)="be di splayed as  follows:"
  11729   "RTN","RCD PEP",97,0)
  11730    S DIR("?" ,3)=" A -  All payers  including  those wit h and with out a flag "
  11731   "RTN","RCD PEP",98,0)
  11732    S DIR("?" ,4)=" P -  Only payer s flagged  for Pharma cy"
  11733   "RTN","RCD PEP",99,0)
  11734    S DIR("?" ,5)=" T -  Only payer s flagged  for Tricar e"
  11735   "RTN","RCD PEP",100,0 )
  11736    S DIR("?" )=" M - Pa yers NOT f lagged for  Pharmacy  or Tricare "
  11737   "RTN","RCD PEP",101,0 )
  11738    ; S DIR(" ??")="RCDP E PAYER FL AGS FILTER "
  11739   "RTN","RCD PEP",102,0 )
  11740    ;
  11741   "RTN","RCD PEP",103,0 )
  11742    D ^DIR
  11743   "RTN","RCD PEP",104,0 )
  11744    I $D(DIRU T) Q -1
  11745   "RTN","RCD PEP",105,0 )
  11746    Q Y
  11747   "RTN","RCD PEP",106,0 )
  11748    ;
  11749   "RTN","RCD PEP",107,0 )
  11750   HDR ; EP -  header co de for RCD PE PAYER F LAGS templ ate
  11751   "RTN","RCD PEP",108,0 )
  11752    ; Input:  Variables  FILTER and  DATEFILT  are assume d to exist
  11753   "RTN","RCD PEP",109,0 )
  11754    ; Output:  ListMan t emplate he ader in VA LMHDR arra y
  11755   "RTN","RCD PEP",110,0 )
  11756    ;
  11757   "RTN","RCD PEP",111,0 )
  11758    ; Show ac tive filte rs in the  template h eader
  11759   "RTN","RCD PEP",112,0 )
  11760    N FTEXT
  11761   "RTN","RCD PEP",113,0 )
  11762    S FTEXT=$ S(FILTER=" P":"Pharma cy",FILTER ="T":"Tric are",FILTE R="M":"Med ical",1:"A ll")
  11763   "RTN","RCD PEP",114,0 )
  11764    S FTEXT=$ $UP^XLFSTR (FTEXT)
  11765   "RTN","RCD PEP",115,0 )
  11766    S FTEXT=F TEXT_" Pay ers"
  11767   "RTN","RCD PEP",116,0 )
  11768    I DATEFIL T D  ;
  11769   "RTN","RCD PEP",117,0 )
  11770    . S FTEXT =FTEXT_" a dded betwe en "
  11771   "RTN","RCD PEP",118,0 )
  11772    . S FTEXT =FTEXT_$$F MTE^XLFDT( $P(DATEFIL T,"^",2)," 2DZ")
  11773   "RTN","RCD PEP",119,0 )
  11774    . S FTEXT =FTEXT_" a nd "_$$FMT E^XLFDT($P (DATEFILT, "^",3),"2D Z")
  11775   "RTN","RCD PEP",120,0 )
  11776    S VALMHDR (1)="Curre nt Filter:  "_FTEXT
  11777   "RTN","RCD PEP",121,0 )
  11778    Q
  11779   "RTN","RCD PEP",122,0 )
  11780    ;
  11781   "RTN","RCD PEP",123,0 )
  11782   INIT ; EP  - init var iables and  list arra y for RCDP E PAYER FL AGS templa te
  11783   "RTN","RCD PEP",124,0 )
  11784    ; Input:  Variables  FILTER and  DATEFILT  are assume d to exist
  11785   "RTN","RCD PEP",125,0 )
  11786    ; Output:  ^TMP("RCD PEP",$J) -  Body line s to displ ay for sel ected temp late
  11787   "RTN","RCD PEP",126,0 )
  11788    ;                                ^TMP($J," RCDPEPIX")  - Index o f displaye d payers
  11789   "RTN","RCD PEP",127,0 )
  11790    S SORT="B "
  11791   "RTN","RCD PEP",128,0 )
  11792    I $G(FILT ER)="" S F ILTER="A"
  11793   "RTN","RCD PEP",129,0 )
  11794    I $G(DATE FILT)="" S  DATEFILT= 0
  11795   "RTN","RCD PEP",130,0 )
  11796    K ^TMP("R CDPEP",$J) ,^TMP($J," RCDPEPIX")
  11797   "RTN","RCD PEP",131,0 )
  11798    D BLD(SOR T,FILTER,D ATEFILT)
  11799   "RTN","RCD PEP",132,0 )
  11800    Q  ;
  11801   "RTN","RCD PEP",133,0 )
  11802    ;
  11803   "RTN","RCD PEP",134,0 )
  11804   BLD(SORT,F ILTER,DATE FILT) ; -  Build the  listman bo dy templat e
  11805   "RTN","RCD PEP",135,0 )
  11806    ; Input:  SORT=Index  on 344.6  to use for  display o rder
  11807   "RTN","RCD PEP",136,0 )
  11808    ; FILTER= Filter bas ed on FLAG  (see EN s ubroutine  for detail )
  11809   "RTN","RCD PEP",137,0 )
  11810    ; DATEFIL T=Filter b ased on da te added.
  11811   "RTN","RCD PEP",138,0 )
  11812    N CNT,LIN E,LN,XX
  11813   "RTN","RCD PEP",139,0 )
  11814    D GETPAY( FILTER,DAT EFILT) ; g et the lis t of payer s sorted a nd filtere d.
  11815   "RTN","RCD PEP",140,0 )
  11816    S VALMBG= 1,VALMCNT= 0,LINE="", CNT=""
  11817   "RTN","RCD PEP",141,0 )
  11818    ;
  11819   "RTN","RCD PEP",142,0 )
  11820    F  D  Q:C NT=""  ;
  11821   "RTN","RCD PEP",143,0 )
  11822    . S CNT=$ O(^TMP($J, "RCDPEPIX" ,CNT))
  11823   "RTN","RCD PEP",144,0 )
  11824    . Q:CNT=" "  ;
  11825   "RTN","RCD PEP",145,0 )
  11826    . S VALMC NT=VALMCNT +1
  11827   "RTN","RCD PEP",146,0 )
  11828    . D BLD1P AY(CNT)
  11829   "RTN","RCD PEP",147,0 )
  11830    Q
  11831   "RTN","RCD PEP",148,0 )
  11832    ;
  11833   "RTN","RCD PEP",149,0 )
  11834   BLD1PAY(PA YCNT) ; (R e)build on e payor li ne into th e listman  array
  11835   "RTN","RCD PEP",150,0 )
  11836    ; Input P AYCNT - Th e sequence  number of  the payer  being bui lt
  11837   "RTN","RCD PEP",151,0 )
  11838    ; Output  - Lines se t into tem plate arra y (^TMP("R CDPEP",$J) ).
  11839   "RTN","RCD PEP",152,0 )
  11840    N DATALN, LINE,XX
  11841   "RTN","RCD PEP",153,0 )
  11842    S LINE=$$ SETSTR^VAL M1(" "_PAY CNT,"",1,4 )
  11843   "RTN","RCD PEP",154,0 )
  11844    S DATALN= ^TMP($J,"R CDPEPIX",P AYCNT)
  11845   "RTN","RCD PEP",155,0 )
  11846    S XX=$P(D ATALN,"^", 2) ; Name
  11847   "RTN","RCD PEP",156,0 )
  11848    S XX=$E(X X,1,55) ;  Truncate n ame to 55  characters  to fit
  11849   "RTN","RCD PEP",157,0 )
  11850    S LINE=$$ SETSTR^VAL M1(XX,LINE ,6,55)
  11851   "RTN","RCD PEP",158,0 )
  11852    S XX=$P(D ATALN,"^", 3) ; Payer  ID
  11853   "RTN","RCD PEP",159,0 )
  11854    S LINE=$$ SETSTR^VAL M1(XX,LINE ,63,10)
  11855   "RTN","RCD PEP",160,0 )
  11856    S XX=$P(D ATALN,"^", 5) ; Phama cy payer f lag
  11857   "RTN","RCD PEP",161,0 )
  11858    S LINE=$$ SETSTR^VAL M1(XX,LINE ,75,2)
  11859   "RTN","RCD PEP",162,0 )
  11860    S XX=$P(D ATALN,"^", 6) ; Trica re payer f lag
  11861   "RTN","RCD PEP",163,0 )
  11862    S LINE=$$ SETSTR^VAL M1(XX,LINE ,79,2)
  11863   "RTN","RCD PEP",164,0 )
  11864    S XX=$P(D ATALN,"^", 4) ; Date  added
  11865   "RTN","RCD PEP",165,0 )
  11866    S LINE=$$ SETSTR^VAL M1(XX,LINE ,82,10)
  11867   "RTN","RCD PEP",166,0 )
  11868    D SET^VAL M10(PAYCNT ,LINE,PAYC NT)
  11869   "RTN","RCD PEP",167,0 )
  11870    S XX=$P(D ATALN,"^", 7) ; EFT o nly payer
  11871   "RTN","RCD PEP",168,0 )
  11872    S LINE=$$ SETSTR^VAL M1(XX,LINE ,93,3)
  11873   "RTN","RCD PEP",169,0 )
  11874    D SET^VAL M10(PAYCNT ,LINE,PAYC NT)
  11875   "RTN","RCD PEP",170,0 )
  11876    Q
  11877   "RTN","RCD PEP",171,0 )
  11878    ;
  11879   "RTN","RCD PEP",172,0 )
  11880   GETPAY(FIL TER,DATEFI LT) ; Retr ieve the p ayors sort ed and fil tered
  11881   "RTN","RCD PEP",173,0 )
  11882    ; Input:  FILTER=Typ e of filte r by Pharm acy or Tri care flag
  11883   "RTN","RCD PEP",174,0 )
  11884    ; DATEFIL T=Filter b y date add ed
  11885   "RTN","RCD PEP",175,0 )
  11886    ; Output:  ^TMP($J," RCDPEPIX") =PIEN^NAME ^PHARMACY_ FLAG^TRICA RE_FLAG
  11887   "RTN","RCD PEP",176,0 )
  11888    N CNT,NAM E,PIEN
  11889   "RTN","RCD PEP",177,0 )
  11890    S CNT=0,N AME=""
  11891   "RTN","RCD PEP",178,0 )
  11892    I $G(SORT )="" S SOR T="B"
  11893   "RTN","RCD PEP",179,0 )
  11894    S FILTER= $G(FILTER)
  11895   "RTN","RCD PEP",180,0 )
  11896    F  D  Q:N AME=""  ;
  11897   "RTN","RCD PEP",181,0 )
  11898    . S NAME= $O(^RCY(34 4.6,SORT,N AME))
  11899   "RTN","RCD PEP",182,0 )
  11900    . Q:NAME= ""
  11901   "RTN","RCD PEP",183,0 )
  11902    . S PIEN= ""
  11903   "RTN","RCD PEP",184,0 )
  11904    . F  S PI EN=$O(^RCY (344.6,SOR T,NAME,PIE N)) Q:PIEN =""  D  ;  PRCA*4.5*3 26
  11905   "RTN","RCD PEP",185,0 )
  11906    . . I '$$ CHKPAY(PIE N,FILTER,D ATEFILT) Q   ;
  11907   "RTN","RCD PEP",186,0 )
  11908    . . S CNT =CNT+1 D G ET1PAY(PIE N,CNT)
  11909   "RTN","RCD PEP",187,0 )
  11910    Q  ;
  11911   "RTN","RCD PEP",188,0 )
  11912    ;
  11913   "RTN","RCD PEP",189,0 )
  11914   GET1PAY(PI EN,CNT) ;  Get the da ta for one  payer and  add it to  the list
  11915   "RTN","RCD PEP",190,0 )
  11916    ; Input:  PIEN - Int ernal entr y number t o file 344 .6
  11917   "RTN","RCD PEP",191,0 )
  11918    ; CNT - I ncremental  counter
  11919   "RTN","RCD PEP",192,0 )
  11920    ; Output:  ^TMP($J," RCDPEPIX", CNT)=A1^A2 ^A3^A4^A5^ A6
  11921   "RTN","RCD PEP",193,0 )
  11922    ; Where A 1=PIEN - T he payer i nternal en try number  on file 3 44.6
  11923   "RTN","RCD PEP",194,0 )
  11924    ;       A 2=NAME - T he payer n ame
  11925   "RTN","RCD PEP",195,0 )
  11926    ;       A 3=PAYER ID  (also kno wn as TIN)
  11927   "RTN","RCD PEP",196,0 )
  11928    ;       A 4=DATE ADD ED
  11929   "RTN","RCD PEP",197,0 )
  11930    ;       A 5=PHARMACY  PAYER - A  Yes/No/Nu ll field t o flag a p ayer as ph armacy
  11931   "RTN","RCD PEP",198,0 )
  11932    ;       A 6=TRICARE  PAYER - A  Yes/No/Nul l filed to  flag a pa yer as tri care
  11933   "RTN","RCD PEP",199,0 )
  11934    ;
  11935   "RTN","RCD PEP",200,0 )
  11936    N DATAOUT ,DATEA,OUT ARR,RCID,R CNAME,RCPF ,RCTF
  11937   "RTN","RCD PEP",201,0 )
  11938    D GETS^DI Q(344.6,PI EN_",",".0 1;.02;.03; .09;.1","E I","OUTARR ")
  11939   "RTN","RCD PEP",202,0 )
  11940    S RCNAME= OUTARR(344 .6,PIEN_", ",.01,"E")
  11941   "RTN","RCD PEP",203,0 )
  11942    S RCID=OU TARR(344.6 ,PIEN_",", .02,"E")
  11943   "RTN","RCD PEP",204,0 )
  11944    S DATAOUT =PIEN
  11945   "RTN","RCD PEP",205,0 )
  11946    S DATAOUT =DATAOUT_" ^"_RCNAME  ; Name
  11947   "RTN","RCD PEP",206,0 )
  11948    S DATAOUT =DATAOUT_" ^"_RCID ;  Payer ID
  11949   "RTN","RCD PEP",207,0 )
  11950    S DATEA=O UTARR(344. 6,PIEN_"," ,.03,"I")  ; Date add ed
  11951   "RTN","RCD PEP",208,0 )
  11952    S DATEA=$ $FMTE^XLFD T(DATEA,"2 DZ") ; For mat as MM/ DD/YY
  11953   "RTN","RCD PEP",209,0 )
  11954    S DATAOUT =DATAOUT_" ^"_DATEA
  11955   "RTN","RCD PEP",210,0 )
  11956    S RCPF=$S (OUTARR(34 4.6,PIEN_" ,",.09,"I" ):"Y",1:"" )
  11957   "RTN","RCD PEP",211,0 )
  11958    S DATAOUT =DATAOUT_" ^"_RCPF ;  Pharmacy p ayer flag
  11959   "RTN","RCD PEP",212,0 )
  11960    S RCTF=$S (OUTARR(34 4.6,PIEN_" ,",.1,"I") :"Y",1:"")
  11961   "RTN","RCD PEP",213,0 )
  11962    S DATAOUT =DATAOUT_" ^"_RCTF ;  Tricare pa yer flag
  11963   "RTN","RCD PEP",214,0 )
  11964    S DATAOUT =DATAOUT_" ^"_$S('$D( ^RCY(344.4 ,"APT",RCN AME,RCID)) :"YES",1:" ") ; EFT O NLY PAYER/ TIN 
  11965   "RTN","RCD PEP",215,0 )
  11966    S ^TMP($J ,"RCDPEPIX ",CNT)=DAT AOUT
  11967   "RTN","RCD PEP",216,0 )
  11968    Q
  11969   "RTN","RCD PEP",217,0 )
  11970    ;
  11971   "RTN","RCD PEP",218,0 )
  11972   CHKPAY(PIE N,FILTER,D ATEFILT) ;  Apply sel ected filt ers to a p ayer
  11973   "RTN","RCD PEP",219,0 )
  11974    ; Input:  PIEN - Int ernal entr y number t o file 344 .6
  11975   "RTN","RCD PEP",220,0 )
  11976    ; FILTER  - A=All pa yers, P=Ph armacy pay ers, T=Tri care payer s,
  11977   "RTN","RCD PEP",221,0 )
  11978    ;           M=Medica l (Neither  Pharmacy  nor Tricar e)
  11979   "RTN","RCD PEP",222,0 )
  11980    ; DATEFIL T - Additi onal Filte r by Date.  Has 3 pie ces by '^'
  11981   "RTN","RCD PEP",223,0 )
  11982    ;             Piece  1 - 1=Filt er by date , 0=Don't
  11983   "RTN","RCD PEP",224,0 )
  11984    ;             Piece  2 - START  - First DA TE ADDED t o include( FM format)
  11985   "RTN","RCD PEP",225,0 )
  11986    ;             Piece  3 - END -  Last DATE  ADDED to i nclude (FM  format)
  11987   "RTN","RCD PEP",226,0 )
  11988    ; Returns : 1 if rec ord matche s filter,  otherwise  0.
  11989   "RTN","RCD PEP",227,0 )
  11990    N D1,D2,D C,CREATED, MATCHT,MAT CHD,PFLAG, TFLAG
  11991   "RTN","RCD PEP",228,0 )
  11992    S (MATCHT ,MATCHD)=0
  11993   "RTN","RCD PEP",229,0 )
  11994    I FILTER= "A" D  ;
  11995   "RTN","RCD PEP",230,0 )
  11996    . S MATCH T=1
  11997   "RTN","RCD PEP",231,0 )
  11998    E  D  ;
  11999   "RTN","RCD PEP",232,0 )
  12000    . S PFLAG =$$GET1^DI Q(344.6,PI EN_",",.09 ,"I")
  12001   "RTN","RCD PEP",233,0 )
  12002    . S TFLAG =$$GET1^DI Q(344.6,PI EN_",",.1, "I")
  12003   "RTN","RCD PEP",234,0 )
  12004    . I FILTE R="P",PFLA G S MATCHT =1
  12005   "RTN","RCD PEP",235,0 )
  12006    . I FILTE R="T",TFLA G S MATCHT =1
  12007   "RTN","RCD PEP",236,0 )
  12008    . I FILTE R="M",'PFL AG,'TFLAG  S MATCHT=1
  12009   "RTN","RCD PEP",237,0 )
  12010    ;
  12011   "RTN","RCD PEP",238,0 )
  12012    I 'DATEFI LT D  ;
  12013   "RTN","RCD PEP",239,0 )
  12014    . S MATCH D=1
  12015   "RTN","RCD PEP",240,0 )
  12016    E  D  ;
  12017   "RTN","RCD PEP",241,0 )
  12018    . S D1=$P (DATEFILT, "^",2)
  12019   "RTN","RCD PEP",242,0 )
  12020    . S D2=$P (DATEFILT, "^",3)
  12021   "RTN","RCD PEP",243,0 )
  12022    . S DC=$$ GET1^DIQ(3 44.6,PIEN_ ",",.03,"I ")
  12023   "RTN","RCD PEP",244,0 )
  12024    . S DC=$P (DC,".",1)  ; strip o ff the tim e portion  for compar ison
  12025   "RTN","RCD PEP",245,0 )
  12026    . I DC=D1 !(DC=D2)!( DC>D1&(DC< D2)) S MAT CHD=1
  12027   "RTN","RCD PEP",246,0 )
  12028    ; 
  12029   "RTN","RCD PEP",247,0 )
  12030    Q MATCHT& MATCHD
  12031   "RTN","RCD PEP",248,0 )
  12032    ;
  12033   "RTN","RCD PEP",249,0 )
  12034   CHKKEY() ;  Check sec urity key  for editin g
  12035   "RTN","RCD PEP",250,0 )
  12036    ; Inputs:  None
  12037   "RTN","RCD PEP",251,0 )
  12038    ; Returns : 1 - User  has secur ity key ed iting, 0 -  User does  not have  key
  12039   "RTN","RCD PEP",252,0 )
  12040    ;
  12041   "RTN","RCD PEP",253,0 )
  12042    Q 1 ; Alw ays return  1 since s ecurity ke y is no lo nger requi red.
  12043   "RTN","RCD PEP",254,0 )
  12044    N RET
  12045   "RTN","RCD PEP",255,0 )
  12046    D OWNSKEY ^XUSRB(.RE T,"RCDPE P AYER IDENT IFY")
  12047   "RTN","RCD PEP",256,0 )
  12048    I 'RET(0)  D  ;
  12049   "RTN","RCD PEP",257,0 )
  12050    . W !!,*7 ,">>>> Sec urity key  RCDPE PAYE R IDENTIFY  is requir ed for thi s action"
  12051   "RTN","RCD PEP",258,0 )
  12052    . D PAUSE ^VALM1
  12053   "RTN","RCD PEP",259,0 )
  12054    Q RET(0)
  12055   "RTN","RCD PEP",260,0 )
  12056    ;
  12057   "RTN","RCD PEP",261,0 )
  12058   EDIT ; EP  - for RCDP E PAYER FL AGS EDIT p rotocol
  12059   "RTN","RCD PEP",262,0 )
  12060    ; Input:  None
  12061   "RTN","RCD PEP",263,0 )
  12062    ; Output:  File 344. 6 is updat ed
  12063   "RTN","RCD PEP",264,0 )
  12064    ;          Listman a rray is up dated
  12065   "RTN","RCD PEP",265,0 )
  12066    ;
  12067   "RTN","RCD PEP",266,0 )
  12068    N DA,DIC, DIE,DO,DR, DTOUT,EDT, LINE,PCNT, PIEN,PROMP T,RET,SEL, X,XX,Y
  12069   "RTN","RCD PEP",267,0 )
  12070    S VALMBCK ="R"
  12071   "RTN","RCD PEP",268,0 )
  12072    D FULL^VA LM1
  12073   "RTN","RCD PEP",269,0 )
  12074    ; Check s ecurity ke y for edit  access
  12075   "RTN","RCD PEP",270,0 )
  12076    I '$$CHKK EY() Q  ;
  12077   "RTN","RCD PEP",271,0 )
  12078    ;
  12079   "RTN","RCD PEP",272,0 )
  12080    S PROMPT= "Select a  Payer Entr y to edit:  "
  12081   "RTN","RCD PEP",273,0 )
  12082    S PIEN=$$ SELENT(1,P ROMPT,VALM BG,VALMLST ,.SEL,"RCD PEPIX",0)
  12083   "RTN","RCD PEP",274,0 )
  12084    Q:'PIEN
  12085   "RTN","RCD PEP",275,0 )
  12086    ;
  12087   "RTN","RCD PEP",276,0 )
  12088    ; Lock Ed iting of t his payer  entry
  12089   "RTN","RCD PEP",277,0 )
  12090    L +^RCY(3 44.6,PIEN) :3 I '$T D   Q
  12091   "RTN","RCD PEP",278,0 )
  12092     . W !!,* 7,"Someone  else is e diting thi s Payer En try."
  12093   "RTN","RCD PEP",279,0 )
  12094     . W !,"T ry again l ater."
  12095   "RTN","RCD PEP",280,0 )
  12096     . D PAUS E^VALM1
  12097   "RTN","RCD PEP",281,0 )
  12098    ;
  12099   "RTN","RCD PEP",282,0 )
  12100    ; Let the  user edit  the payer  entry
  12101   "RTN","RCD PEP",283,0 )
  12102    S DIE="^R CY(344.6,"
  12103   "RTN","RCD PEP",284,0 )
  12104    W !!,"Edi t flags fo r payer :  "_$$GET1^D IQ(344.6,P IEN_",",.0 1,"E"),!
  12105   "RTN","RCD PEP",285,0 )
  12106    S DA=PIEN
  12107   "RTN","RCD PEP",286,0 )
  12108    S DR=".09 Pharmacy F lag;.1Tric are Flag"
  12109   "RTN","RCD PEP",287,0 )
  12110    D ^DIE
  12111   "RTN","RCD PEP",288,0 )
  12112    ;
  12113   "RTN","RCD PEP",289,0 )
  12114    L -^RCY(3 44.6,PIEN)
  12115   "RTN","RCD PEP",290,0 )
  12116    D GET1PAY (PIEN,+SEL )
  12117   "RTN","RCD PEP",291,0 )
  12118    D BLD1PAY (+SEL)
  12119   "RTN","RCD PEP",292,0 )
  12120    Q
  12121   "RTN","RCD PEP",293,0 )
  12122    ;
  12123   "RTN","RCD PEP",294,0 )
  12124   SELENT(FUL L,PROMPT,S TART,END,P CNT,WLIST, MULT) ; EP  - Protoco l Action
  12125   "RTN","RCD PEP",295,0 )
  12126    ; Select  Entry(s) t o perform  an action  upon
  12127   "RTN","RCD PEP",296,0 )
  12128    ; Called  from proto cols : RCD PE PAYER F LAGS EDIT
  12129   "RTN","RCD PEP",297,0 )
  12130    ; RCDPE P AYER FLAG  PHARM
  12131   "RTN","RCD PEP",298,0 )
  12132    ; RCDPE P AYER FLAG  TRIC
  12133   "RTN","RCD PEP",299,0 )
  12134    ; Input:  FULL - 1 -  full scre en mode, 0  otherwise
  12135   "RTN","RCD PEP",300,0 )
  12136    ;         PROMPT - P rompt to b e displaye d to the u ser
  12137   "RTN","RCD PEP",301,0 )
  12138    ;         START - St arting sel ection val ue
  12139   "RTN","RCD PEP",302,0 )
  12140    ;         END - Endi ng selecti on value
  12141   "RTN","RCD PEP",303,0 )
  12142    ;         WLIST - Wo rklist, th e user is  selecting  from
  12143   "RTN","RCD PEP",304,0 )
  12144    ;                 Op tional, de faults to  'RCDPEPIX'
  12145   "RTN","RCD PEP",305,0 )
  12146    ;         MULT - 1 t o allow mu ltiple sel ection,
  12147   "RTN","RCD PEP",306,0 )
  12148    ;                0 o r null oth erwise
  12149   "RTN","RCD PEP",307,0 )
  12150    ;                Opt ional defa ults to 0
  12151   "RTN","RCD PEP",308,0 )
  12152    ; Output:  PCNT - Se lected Pho ne Book En try line(s )
  12153   "RTN","RCD PEP",309,0 )
  12154    ; Returns : Selected  Payer Ent ry IEN(s)
  12155   "RTN","RCD PEP",310,0 )
  12156    ;           Error me ssage if i nvalid sel ection
  12157   "RTN","RCD PEP",311,0 )
  12158    N CTR,DIR OUT,DIRUT, DLINE,DTOU T,DUOUT,PI EN,PIENS,X ,XX,Y,YY
  12159   "RTN","RCD PEP",312,0 )
  12160    S:'$D(WLI ST) WLIST= "RCDPEPIX"
  12161   "RTN","RCD PEP",313,0 )
  12162    S:'$D(MUL T) MULT=0
  12163   "RTN","RCD PEP",314,0 )
  12164    D:FULL FU LL^VALM1
  12165   "RTN","RCD PEP",315,0 )
  12166    ; Check f or multi-s election
  12167   "RTN","RCD PEP",316,0 )
  12168    S PCNT=$$ PARSEL($G( XQORNOD(0) ),START,EN D)
  12169   "RTN","RCD PEP",317,0 )
  12170    ;
  12171   "RTN","RCD PEP",318,0 )
  12172    ; W !!!," PCNT="_PCN T_" MULT=" _MULT H 10
  12173   "RTN","RCD PEP",319,0 )
  12174    I 'MULT,$ P(PCNT,"," ,2) D  Q " "                        ; Inval id multi-s election
  12175   "RTN","RCD PEP",320,0 )
  12176    . W !,*7, ">>>> Only  single en try select ion is all owed"
  12177   "RTN","RCD PEP",321,0 )
  12178    . K DIR
  12179   "RTN","RCD PEP",322,0 )
  12180    . D PAUSE ^VALM1
  12181   "RTN","RCD PEP",323,0 )
  12182    S:PCNT=""  PCNT=$$SE LENTRY(PRO MPT,START, END,MULT)
  12183   "RTN","RCD PEP",324,0 )
  12184    Q:'PCNT " "
  12185   "RTN","RCD PEP",325,0 )
  12186    ;
  12187   "RTN","RCD PEP",326,0 )
  12188    S PIENS=" "
  12189   "RTN","RCD PEP",327,0 )
  12190    F CTR=1:1 :$L(PCNT," ,") D
  12191   "RTN","RCD PEP",328,0 )
  12192    . S XX=$P (PCNT,",", CTR)
  12193   "RTN","RCD PEP",329,0 )
  12194    . I XX'=" " D  ;
  12195   "RTN","RCD PEP",330,0 )
  12196    . . S YY= $P(^TMP($J ,WLIST,XX) ,"^",1)
  12197   "RTN","RCD PEP",331,0 )
  12198    . . S PIE NS=$S(PIEN S="":YY,1: PIENS_","_ YY)
  12199   "RTN","RCD PEP",332,0 )
  12200    Q PIENS
  12201   "RTN","RCD PEP",333,0 )
  12202    ;
  12203   "RTN","RCD PEP",334,0 )
  12204   SELENTRY(P ROMPT,STAR T,END,MULT ) ; Select  a line 
  12205   "RTN","RCD PEP",335,0 )
  12206    ; Input:  PROMPT - P rompt to b e displaye d to the u ser
  12207   "RTN","RCD PEP",336,0 )
  12208    ; START -  Start com ment # tha t can be s elected
  12209   "RTN","RCD PEP",337,0 )
  12210    ; END - E nding comm ent # that  can be se lected
  12211   "RTN","RCD PEP",338,0 )
  12212    ; MULT -  1=Multiple  selection  allowed,  0=otherwis e
  12213   "RTN","RCD PEP",339,0 )
  12214    ; Returns : Selected  Comment #  or "" if  not select ed
  12215   "RTN","RCD PEP",340,0 )
  12216    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
  12217   "RTN","RCD PEP",341,0 )
  12218    S MULT=+$ G(MULT)
  12219   "RTN","RCD PEP",342,0 )
  12220    S DIR(0)= $S(MULT:"L ",1:"N")_" O^"_START_ ":"_END_": 0"
  12221   "RTN","RCD PEP",343,0 )
  12222    S DIR("A" )=PROMPT
  12223   "RTN","RCD PEP",344,0 )
  12224    D ^DIR K  DIR
  12225   "RTN","RCD PEP",345,0 )
  12226    Q Y
  12227   "RTN","RCD PEP",346,0 )
  12228    ;
  12229   "RTN","RCD PEP",347,0 )
  12230   FLAGP ; EP  - for RCD PE PAYER F LAG PHARM  protocol
  12231   "RTN","RCD PEP",348,0 )
  12232    ; Toggle  pharmacy f lag on sel ected line s
  12233   "RTN","RCD PEP",349,0 )
  12234    ; Input:  None
  12235   "RTN","RCD PEP",350,0 )
  12236    ; Output:  None 
  12237   "RTN","RCD PEP",351,0 )
  12238    D FLAG("P ")
  12239   "RTN","RCD PEP",352,0 )
  12240    Q
  12241   "RTN","RCD PEP",353,0 )
  12242    ;
  12243   "RTN","RCD PEP",354,0 )
  12244   FLAGT ; EP  - for RCD PE PAYER F LAG TRIC p rotocol
  12245   "RTN","RCD PEP",355,0 )
  12246    ; Toggle  Tricare fl ag on sele cted lines
  12247   "RTN","RCD PEP",356,0 )
  12248    ; Input:  None
  12249   "RTN","RCD PEP",357,0 )
  12250    ; Output:  None 
  12251   "RTN","RCD PEP",358,0 )
  12252    D FLAG("T ")
  12253   "RTN","RCD PEP",359,0 )
  12254    Q
  12255   "RTN","RCD PEP",360,0 )
  12256    ;
  12257   "RTN","RCD PEP",361,0 )
  12258   FLAG(TYPE)  ; Flag a  list of en tries as P harmacy or  Tricare
  12259   "RTN","RCD PEP",362,0 )
  12260    ; Input:  TYPE - P=P harmacy, T =Tricare
  12261   "RTN","RCD PEP",363,0 )
  12262    ; Output:  File 344. 6 is updat ed
  12263   "RTN","RCD PEP",364,0 )
  12264    ; ListMan  array is  updated
  12265   "RTN","RCD PEP",365,0 )
  12266    N CONTINU E,CTR,FIEL D,PERR,PIE N,PIENS,PR OMPT,SELS, STOP,XX,ZS ,ZZ
  12267   "RTN","RCD PEP",366,0 )
  12268    S FIELD=$ S(TYPE="P" :.09,1:.1)
  12269   "RTN","RCD PEP",367,0 )
  12270    S VALMBCK ="R"
  12271   "RTN","RCD PEP",368,0 )
  12272    ; Check s ecurity ke y for edit  access
  12273   "RTN","RCD PEP",369,0 )
  12274    I '$$CHKK EY() Q  ;
  12275   "RTN","RCD PEP",370,0 )
  12276    ;
  12277   "RTN","RCD PEP",371,0 )
  12278    S PROMPT= "Select li nes on whi ch to togg le "
  12279   "RTN","RCD PEP",372,0 )
  12280    S PROMPT= PROMPT_$S( TYPE="P":" Pharmacy", 1:"Tricare ")_" Flag"
  12281   "RTN","RCD PEP",373,0 )
  12282    S PIENS=$ $SELENT(1, PROMPT,VAL MBG,VALMLS T,.SELS,"R CDPEPIX",1 )
  12283   "RTN","RCD PEP",374,0 )
  12284    Q:PIENS=" "  ;
  12285   "RTN","RCD PEP",375,0 )
  12286    S (PERR,P IEN,ZZ,ZS) =""
  12287   "RTN","RCD PEP",376,0 )
  12288    ;
  12289   "RTN","RCD PEP",377,0 )
  12290    ; First l ock all en tries to b e deleted
  12291   "RTN","RCD PEP",378,0 )
  12292    F CTR=1:1 :$L(PIENS, ",") D
  12293   "RTN","RCD PEP",379,0 )
  12294    . S PIEN= $P(PIENS," ,",CTR) I  PIEN="" Q   ;
  12295   "RTN","RCD PEP",380,0 )
  12296    . S XX=$P (SELS,",", CTR)
  12297   "RTN","RCD PEP",381,0 )
  12298    . ;
  12299   "RTN","RCD PEP",382,0 )
  12300    . ; Lock  this payer  exclusion  for editi ng 
  12301   "RTN","RCD PEP",383,0 )
  12302    . L +^RCY (344.6,PIE N):3 I '$T  D  Q
  12303   "RTN","RCD PEP",384,0 )
  12304    . . S PER R=$S(PERR= "":XX,1:PE RR_","_XX)
  12305   "RTN","RCD PEP",385,0 )
  12306    . S ZZ=$S (ZZ="":PIE N,1:ZZ_"," _PIEN)
  12307   "RTN","RCD PEP",386,0 )
  12308    . S ZS=$S (ZS="":XX, 1:ZS_","_X X)
  12309   "RTN","RCD PEP",387,0 )
  12310    S PIENS=Z Z                                   ; Entry (s) that c an be dele ted
  12311   "RTN","RCD PEP",388,0 )
  12312    S SELS=ZS
  12313   "RTN","RCD PEP",389,0 )
  12314    ;
  12315   "RTN","RCD PEP",390,0 )
  12316    ; Did we  lock at le ast one en try?
  12317   "RTN","RCD PEP",391,0 )
  12318    I PIENS=" " D  Q
  12319   "RTN","RCD PEP",392,0 )
  12320    . W !!,*7 ,"All entr ies are be ing edited  by anothe r user - N othing don e."
  12321   "RTN","RCD PEP",393,0 )
  12322    . D PAUSE ^VALM1
  12323   "RTN","RCD PEP",394,0 )
  12324    ;
  12325   "RTN","RCD PEP",395,0 )
  12326    ; Next wa rn the use r if we co uldn't loc k them all
  12327   "RTN","RCD PEP",396,0 )
  12328    I PERR'=" " D  Q:STO P
  12329   "RTN","RCD PEP",397,0 )
  12330    . S STOP= 0
  12331   "RTN","RCD PEP",398,0 )
  12332    . W !!,*7 ,"Warning:  The follo wing entri es: ",PERR ," are bei ng edited  by another  user"
  12333   "RTN","RCD PEP",399,0 )
  12334    . W !,"Th ese entrie s will not  be update d."
  12335   "RTN","RCD PEP",400,0 )
  12336    . S CONTI NUE=$$ASKY N("Continu e with upd ate of oth er payers? ")
  12337   "RTN","RCD PEP",401,0 )
  12338    . I 'CONT INUE D
  12339   "RTN","RCD PEP",402,0 )
  12340    . . S STO P=1
  12341   "RTN","RCD PEP",403,0 )
  12342    . . F CTR =1:1:$L(PI ENS,",") D
  12343   "RTN","RCD PEP",404,0 )
  12344    . . . S P IEN=$P(PIE NS,",",CTR )
  12345   "RTN","RCD PEP",405,0 )
  12346    . . . L - ^RCY(344.6 ,PIEN)
  12347   "RTN","RCD PEP",406,0 )
  12348    ;
  12349   "RTN","RCD PEP",407,0 )
  12350    ; Flag se lected ent ries
  12351   "RTN","RCD PEP",408,0 )
  12352    F CTR=1:1 :$L(PIENS, ",") D  ;
  12353   "RTN","RCD PEP",409,0 )
  12354    . N FDA,I ENS,OLDVAL ,VALUE
  12355   "RTN","RCD PEP",410,0 )
  12356    . S PIEN= $P(PIENS," ,",CTR)
  12357   "RTN","RCD PEP",411,0 )
  12358    . S IENS= PIEN_","
  12359   "RTN","RCD PEP",412,0 )
  12360    . S SEL=$ P(SELS,"," ,CTR)
  12361   "RTN","RCD PEP",413,0 )
  12362    . S OLDVA L=$$GET1^D IQ(344.6,I ENS,FIELD, "I")
  12363   "RTN","RCD PEP",414,0 )
  12364    . S VALUE =$S('OLDVA L:1,1:0)
  12365   "RTN","RCD PEP",415,0 )
  12366    . S FDA(3 44.6,IENS, FIELD)=VAL UE
  12367   "RTN","RCD PEP",416,0 )
  12368    . L -^RCY (344.6,PIE N)
  12369   "RTN","RCD PEP",417,0 )
  12370    . D FILE^ DIE("","FD A")
  12371   "RTN","RCD PEP",418,0 )
  12372    . D GET1P AY(PIEN,SE L)
  12373   "RTN","RCD PEP",419,0 )
  12374    . D BLD1P AY(SEL)
  12375   "RTN","RCD PEP",420,0 )
  12376    Q
  12377   "RTN","RCD PEP",421,0 )
  12378    ;
  12379   "RTN","RCD PEP",422,0 )
  12380   FILTER ; E P - for RC DPE PAYER  FLAGS FILT ER protoco l
  12381   "RTN","RCD PEP",423,0 )
  12382    ; Change  the filter  from a pr otocol
  12383   "RTN","RCD PEP",424,0 )
  12384    ; Inputs  - None
  12385   "RTN","RCD PEP",425,0 )
  12386    ; Output  - Sets var iables FIL TER and DA TEFILT
  12387   "RTN","RCD PEP",426,0 )
  12388    N NEWDATE ,NEWFILT
  12389   "RTN","RCD PEP",427,0 )
  12390    S VALMBCK ="R"
  12391   "RTN","RCD PEP",428,0 )
  12392    D FULL^VA LM1
  12393   "RTN","RCD PEP",429,0 )
  12394    S NEWDATE =$$GETDATE ()
  12395   "RTN","RCD PEP",430,0 )
  12396    I NEWDATE =-1 Q  ;
  12397   "RTN","RCD PEP",431,0 )
  12398    S NEWFILT =$$GETFILT ()
  12399   "RTN","RCD PEP",432,0 )
  12400    I NEWFILT =-1 Q  ;
  12401   "RTN","RCD PEP",433,0 )
  12402    S DATEFIL T=NEWDATE
  12403   "RTN","RCD PEP",434,0 )
  12404    S FILTER= NEWFILT
  12405   "RTN","RCD PEP",435,0 )
  12406    D HDR,INI T
  12407   "RTN","RCD PEP",436,0 )
  12408    Q
  12409   "RTN","RCD PEP",437,0 )
  12410    ;
  12411   "RTN","RCD PEP",438,0 )
  12412   PARSEL(VAL MNOD,BEG,E ND) ; -- s plit out p re-answers  from user
  12413   "RTN","RCD PEP",439,0 )
  12414    ; Inputs  - VALMNOD=  User inpu t from pro tocol menu  including  pre-answe rs
  12415   "RTN","RCD PEP",440,0 )
  12416    ;           BEG=Begi ning of th e valid nu meric rang e
  12417   "RTN","RCD PEP",441,0 )
  12418    ;           END=End  of the val id numeric  range
  12419   "RTN","RCD PEP",442,0 )
  12420    ; Returns  - Y=Comma  separated  list of v alid numer ic entries
  12421   "RTN","RCD PEP",443,0 )
  12422    ;
  12423   "RTN","RCD PEP",444,0 )
  12424    ; This co de is adap ted from V ALM2. 
  12425   "RTN","RCD PEP",445,0 )
  12426    N I,J,L,X ,Y
  12427   "RTN","RCD PEP",446,0 )
  12428    S Y=$TR($ P($P(VALMN OD,U,4),"= ",2),"/\;  .",",,,,," )
  12429   "RTN","RCD PEP",447,0 )
  12430    ; Run thr ough the l ist, skip  invalid se lections a nd expand  ranges
  12431   "RTN","RCD PEP",448,0 )
  12432    S X=Y,Y=" "
  12433   "RTN","RCD PEP",449,0 )
  12434    F I=1:1 S  J=$P(X,", ",I) Q:J=" "  D  ;
  12435   "RTN","RCD PEP",450,0 )
  12436    . I J'["- ",J>(BEG-1 ),J<(END+1 ) S Y=Y_J_ "," ; sing le valid s election 
  12437   "RTN","RCD PEP",451,0 )
  12438    . I J["-" ,J,J<$P(J, "-",2) D   ;
  12439   "RTN","RCD PEP",452,0 )
  12440    . . F L=+ J:1:+$P(J, "-",2) D   ;
  12441   "RTN","RCD PEP",453,0 )
  12442    . . . I L >(BEG-1),L <(END+1) S  Y=Y_L_","  ; valid s election f rom expand ed range
  12443   "RTN","RCD PEP",454,0 )
  12444    Q Y
  12445   "RTN","RCD PEP",455,0 )
  12446    ;
  12447   "RTN","RCD PEP",456,0 )
  12448   PARSED(X)  ; Take a d ate in ext ernal form at and che ck if it i s a valid
  12449   "RTN","RCD PEP",457,0 )
  12450              ; DATE ADD ED (.03) i n file 344 .6
  12451   "RTN","RCD PEP",458,0 )
  12452    ; Input -  Date in E xternal fo rmat
  12453   "RTN","RCD PEP",459,0 )
  12454    ; Output  - Date in  Fileman fo rmat or 0  if the inp ut was inv alid
  12455   "RTN","RCD PEP",460,0 )
  12456    D VAL^DIE (344.6,"+1 ,",.03,"", X,.RET)
  12457   "RTN","RCD PEP",461,0 )
  12458    Q RET
  12459   "RTN","RCD PEP",462,0 )
  12460    ;
  12461   "RTN","RCD PEP",463,0 )
  12462   ASKYN(PROM PT,DEFAULT ) ; Ask a  yes/no que stion
  12463   "RTN","RCD PEP",464,0 )
  12464    ; Input:  PROMPT - Q uestion to  be asked
  12465   "RTN","RCD PEP",465,0 )
  12466    ;         DEFAULT -  Default An swer
  12467   "RTN","RCD PEP",466,0 )
  12468    ;         1 - YES, 0  - NO
  12469   "RTN","RCD PEP",467,0 )
  12470    ;         Optional,  defaults t o 0
  12471   "RTN","RCD PEP",468,0 )
  12472    ; Returns : 1 - User  answered  YES, 0 oth ewise
  12473   "RTN","RCD PEP",469,0 )
  12474    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,X,Y
  12475   "RTN","RCD PEP",470,0 )
  12476    S:$G(DEFA ULT)'=1 DE FAULT=0
  12477   "RTN","RCD PEP",471,0 )
  12478    S DIR(0)= "Y",DIR("A ")=PROMPT
  12479   "RTN","RCD PEP",472,0 )
  12480    S DIR("B" )=$S(DEFAU LT:"YES",1 :"NO")
  12481   "RTN","RCD PEP",473,0 )
  12482    D ^DIR
  12483   "RTN","RCD PEP",474,0 )
  12484    Q Y
  12485   "RTN","RCD PEP",475,0 )
  12486    ;
  12487   "RTN","RCD PEP",476,0 )
  12488   HELP ; EP  - for temp late RCDPE  PAYER FLA GS help
  12489   "RTN","RCD PEP",477,0 )
  12490    ; Input:  None
  12491   "RTN","RCD PEP",478,0 )
  12492    ; Output:  Text from  a help fr ame displa yed to the  screen
  12493   "RTN","RCD PEP",479,0 )
  12494    N FILTER, DATEFILT,X QH
  12495   "RTN","RCD PEP",480,0 )
  12496    S VALMBCK ="R"
  12497   "RTN","RCD PEP",481,0 )
  12498    S XQH="RC DPE PAYER  FLAGS GENE RAL"
  12499   "RTN","RCD PEP",482,0 )
  12500    D EN^XQH
  12501   "RTN","RCD PEP",483,0 )
  12502    Q
  12503   "RTN","RCD PEP",484,0 )
  12504    ;
  12505   "RTN","RCD PEP",485,0 )
  12506   EXIT ; --  exit code
  12507   "RTN","RCD PEP",486,0 )
  12508    D FULL^VA LM1
  12509   "RTN","RCD PEP",487,0 )
  12510    Q
  12511   "RTN","RCD PESP")
  12512   0^20^B1422 29287
  12513   "RTN","RCD PESP",1,0)
  12514   RCDPESP ;B IRM/EWL -  ePayment L ockbox Sit e Paramete rs Definit ion - File s 344.61 &  344.6 ;27  Sept 2018  15:56:10
  12515   "RTN","RCD PESP",2,0)
  12516    ;;4.5;Acc ounts Rece ivable;**2 98,304,318 ,321,326,3 32**;Mar 2 0, 1995;Bu ild 34
  12517   "RTN","RCD PESP",3,0)
  12518    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  12519   "RTN","RCD PESP",4,0)
  12520    ;
  12521   "RTN","RCD PESP",5,0)
  12522   EN ; entry  point for  EDI Lockb ox Paramet ers [RCDPE  EDI LOCKB OX PARAMET ERS]
  12523   "RTN","RCD PESP",6,0)
  12524    N DA,DIC, DIE,DIR,DI RUT,DLAYGO ,DR,DTOUT, DUOUT,X,Y   ; FileMan  variables
  12525   "RTN","RCD PESP",7,0)
  12526    ;
  12527   "RTN","RCD PESP",8,0)
  12528    W !," Upd ate AR Sit e Paramete rs",!
  12529   "RTN","RCD PESP",9,0)
  12530    ;
  12531   "RTN","RCD PESP",10,0 )
  12532    S X="RCDP E AUTO DEC " I '$D(^X USEC(X,DUZ )) W !!,"Y ou do not  hold the " _X_" secur ity key."  Q
  12533   "RTN","RCD PESP",11,0 )
  12534    ; Lock th e paramete r file
  12535   "RTN","RCD PESP",12,0 )
  12536    L +^RCY(3 44.61,1):D ILOCKTM E   D  Q
  12537   "RTN","RCD PESP",13,0 )
  12538    . W !!,"  Another us er is curr ently usin g the AR S ite Parame ters optio n."
  12539   "RTN","RCD PESP",14,0 )
  12540    . W !," P lease try  again late r."
  12541   "RTN","RCD PESP",15,0 )
  12542    ;
  12543   "RTN","RCD PESP",16,0 )
  12544    ; PRCA*4. 5*326 - On ce lock is  successfu l, take a  snapshot o f the para meters for  monitorin g
  12545   "RTN","RCD PESP",17,0 )
  12546    D EN^RCDP ESP6
  12547   "RTN","RCD PESP",18,0 )
  12548    ;
  12549   "RTN","RCD PESP",19,0 )
  12550    ; Check p arameter f ile
  12551   "RTN","RCD PESP",20,0 )
  12552    N FDAEDI, FDAPAYER,I EN,IENS,RC QUIT
  12553   "RTN","RCD PESP",21,0 )
  12554    ; FDAPAYE R - FDA ar ray for RC DPE AUTO-P AY EXCLUSI ON file (# 344.6)
  12555   "RTN","RCD PESP",22,0 )
  12556    ; FDAEDI  - FDA arra y for RCDP E PARAMETE R file (#3 44.61)
  12557   "RTN","RCD PESP",23,0 )
  12558    ; RCAUDVA L - audit  data for R CDPE PARAM ETER AUDIT  file (#34 4.7)
  12559   "RTN","RCD PESP",24,0 )
  12560    ; IEN - e ntry #
  12561   "RTN","RCD PESP",25,0 )
  12562    ; IENS -  IEN_comma
  12563   "RTN","RCD PESP",26,0 )
  12564    ; RCQUIT  - exit fla g
  12565   "RTN","RCD PESP",27,0 )
  12566    ;
  12567   "RTN","RCD PESP",28,0 )
  12568    ; functio n returns  1 on succe ss
  12569   "RTN","RCD PESP",29,0 )
  12570    S Y=$$EDI LOCK^RCMSI TE  ; Upda te EDI Loc kbox site  parameters
  12571   "RTN","RCD PESP",30,0 )
  12572    I 'Y G AB ORT  ; use r entered  '^'
  12573   "RTN","RCD PESP",31,0 )
  12574    ;
  12575   "RTN","RCD PESP",32,0 )
  12576    ; PRCA*4. 5*304 - En able/disab le auto-au diting of  paper bill s
  12577   "RTN","RCD PESP",33,0 )
  12578    S RCQUIT= 0 W !
  12579   "RTN","RCD PESP",34,0 )
  12580    S RCQUIT= $$AUDIT^RC DPESP5
  12581   "RTN","RCD PESP",35,0 )
  12582    I RCQUIT  G ABORT ;  PRCA*4.5*3 26 must ha ve single  exit point
  12583   "RTN","RCD PESP",36,0 )
  12584    ;
  12585   "RTN","RCD PESP",37,0 )
  12586    W !
  12587   "RTN","RCD PESP",38,0 )
  12588    I '$D(^RC Y(344.61,1 ,0)) W !," There is a  problem w ith the RC DPE PARAME TER file ( #344.61)."  G EXIT
  12589   "RTN","RCD PESP",39,0 )
  12590    ;
  12591   "RTN","RCD PESP",40,0 )
  12592    ; PRCA*4. 5*321
  12593   "RTN","RCD PESP",41,0 )
  12594    ; WORKLOA D NOTIFICA TION BULLE TIN DAYS
  12595   "RTN","RCD PESP",42,0 )
  12596    N BULL S  BULL=$$GET 1^DIQ(344. 61,"1,",.1 ,"I")
  12597   "RTN","RCD PESP",43,0 )
  12598    K DIR S:B ULL]"" DIR ("B")=$$GE T1^DIQ(344 .61,"1,",. 1,"E")
  12599   "RTN","RCD PESP",44,0 )
  12600    S DIR("?" )=$$GET1^D ID(344.61, .1,,"HELP- PROMPT")
  12601   "RTN","RCD PESP",45,0 )
  12602    S DIR("A" )=$$GET1^D ID(344.61, .1,,"TITLE ")
  12603   "RTN","RCD PESP",46,0 )
  12604    S DIR(0)= "344.61,.1 "
  12605   "RTN","RCD PESP",47,0 )
  12606    D ^DIR I  $D(DTOUT)! $D(DUOUT)  G ABORT
  12607   "RTN","RCD PESP",48,0 )
  12608    I BULL'=Y  D  ; upda te and aud it
  12609   "RTN","RCD PESP",49,0 )
  12610    . S RCAUD VAL(1)="34 4.61^.1^1^ "_Y_U_BULL
  12611   "RTN","RCD PESP",50,0 )
  12612    . S FDAED I(344.61," 1,",.1)=Y  D FILE^DIE (,"FDAEDI" )
  12613   "RTN","RCD PESP",51,0 )
  12614    . D AUDIT (.RCAUDVAL ) K RCAUDV AL
  12615   "RTN","RCD PESP",52,0 )
  12616    W !
  12617   "RTN","RCD PESP",53,0 )
  12618    ;
  12619   "RTN","RCD PESP",54,0 )
  12620    ; Enable/ disable au to-posting  of medica l claims
  12621   "RTN","RCD PESP",55,0 )
  12622    N APMC,AP MCT
  12623   "RTN","RCD PESP",56,0 )
  12624    ;PRCA*4.5 *304 Move  from Medic al Auto de crease sec tion below
  12625   "RTN","RCD PESP",57,0 )
  12626    N ADMC  ;  ^DD(344.6 1,.02,0)=" AUTO-POST  MED CLAIMS  ENABLED^S ^0:No;1:Ye s;^0;2^Q"
  12627   "RTN","RCD PESP",58,0 )
  12628    S ADMC=""   ; Init i n case Med ical Auto  Posting is  turned of f.
  12629   "RTN","RCD PESP",59,0 )
  12630    ;end PRCA *4.5*304
  12631   "RTN","RCD PESP",60,0 )
  12632    ; APMC=AU TO POSTING  OF MEDICA L CLAIMS E NABLED
  12633   "RTN","RCD PESP",61,0 )
  12634    ; APMCT=T EMP APMC
  12635   "RTN","RCD PESP",62,0 )
  12636    S APMCT=$ $GET1^DIQ( 344.61,"1, ",.02,"I") ,APMC=$S(A PMCT=1:"Ye s",APMCT=0 :"No",1:"" )
  12637   "RTN","RCD PESP",63,0 )
  12638    K DIR S D IR(0)="YA" ,DIR("B")= $S(APMC="" :"Y",1:APM C)
  12639   "RTN","RCD PESP",64,0 )
  12640    S DIR("A" )=$$GET1^D ID(344.61, .02,,"TITL E")
  12641   "RTN","RCD PESP",65,0 )
  12642    S DIR("?" )=$$GET1^D ID(344.61, .02,,"HELP -PROMPT")
  12643   "RTN","RCD PESP",66,0 )
  12644    D ^DIR I  $D(DTOUT)! $D(DUOUT)  G ABORT
  12645   "RTN","RCD PESP",67,0 )
  12646    I APMCT'= Y D  ; use r updated  value
  12647   "RTN","RCD PESP",68,0 )
  12648    .S FDAEDI (344.61,"1 ,",.02)=Y  D FILE^DIE (,"FDAEDI" ) K FDAEDI
  12649   "RTN","RCD PESP",69,0 )
  12650    .D NOTIFY ($S(Y=1:"Y es",Y=0:"N o",1:"*mis sing*"))
  12651   "RTN","RCD PESP",70,0 )
  12652    .S RCAUDV AL(1)="344 .61^.02^1^ "_Y_U_('Y)  D AUDIT(. RCAUDVAL)  K RCAUDVAL
  12653   "RTN","RCD PESP",71,0 )
  12654    ;
  12655   "RTN","RCD PESP",72,0 )
  12656    I Y=0 G R XPARMS
  12657   "RTN","RCD PESP",73,0 )
  12658    ;
  12659   "RTN","RCD PESP",74,0 )
  12660    ; Set/Res et payer e xclusions  for medica l claim po sting
  12661   "RTN","RCD PESP",75,0 )
  12662    D EXCLLIS T(1) ; Dis play the e xclusion l ist
  12663   "RTN","RCD PESP",76,0 )
  12664    D SETEXCL (1) I $G(R CQUIT) G A BORT ; SET /RESET exc lusions
  12665   "RTN","RCD PESP",77,0 )
  12666    D EXCLLIS T(1) ; Dis play the e xclusion l ist
  12667   "RTN","RCD PESP",78,0 )
  12668    W !
  12669   "RTN","RCD PESP",79,0 )
  12670    ;
  12671   "RTN","RCD PESP",80,0 )
  12672    ; Enable/ disable au to-decreas e of paid  medical cl aims
  12673   "RTN","RCD PESP",81,0 )
  12674    N RETURN
  12675   "RTN","RCD PESP",82,0 )
  12676    S RETURN= $$PAID^RCD PESP7
  12677   "RTN","RCD PESP",83,0 )
  12678    G:RETURN= 2 RXPARMS
  12679   "RTN","RCD PESP",84,0 )
  12680    ;
  12681   "RTN","RCD PESP",85,0 )
  12682    ; Enable/ disable au to-decreas e of non-p aid medica l claims
  12683   "RTN","RCD PESP",86,0 )
  12684    I RETURN= 0 S RETURN =$$NOPAY^R CDPESP7
  12685   "RTN","RCD PESP",87,0 )
  12686    ;
  12687   "RTN","RCD PESP",88,0 )
  12688    I RETURN= 1 G ABORT
  12689   "RTN","RCD PESP",89,0 )
  12690    ;
  12691   "RTN","RCD PESP",90,0 )
  12692    ; Set/Res et payer e xclusions  for medica l claim de crease
  12693   "RTN","RCD PESP",91,0 )
  12694    D EXCLLIS T(2) ; Dis play the e xclusion l ist
  12695   "RTN","RCD PESP",92,0 )
  12696    D SETEXCL (2) I $G(R CQUIT) G A BORT ; SET /RESET exc lusions
  12697   "RTN","RCD PESP",93,0 )
  12698    D EXCLLIS T(2) ; Dis play the e xclusion l ist
  12699   "RTN","RCD PESP",94,0 )
  12700    W !
  12701   "RTN","RCD PESP",95,0 )
  12702    ;
  12703   "RTN","RCD PESP",96,0 )
  12704    ; code fa lls throug h
  12705   "RTN","RCD PESP",97,0 )
  12706    ;
  12707   "RTN","RCD PESP",98,0 )
  12708   RXPARMS ;  branch her e from abo ve
  12709   "RTN","RCD PESP",99,0 )
  12710    ;
  12711   "RTN","RCD PESP",100, 0)
  12712    ; Enable/ disable au to-posting  of pharma cy claims
  12713   "RTN","RCD PESP",101, 0)
  12714    N APPC,AP PCT
  12715   "RTN","RCD PESP",102, 0)
  12716    ; APPC=AU TO POSTING  OF PHARMA CY CLAIMS  ENABLED
  12717   "RTN","RCD PESP",103, 0)
  12718    ; APPCT=T EMP APMC
  12719   "RTN","RCD PESP",104, 0)
  12720    S APPCT=$ $GET1^DIQ( 344.61,"1, ",1.01,"I" ),APPC=$S( APPCT=1:"Y es",APPCT= 0:"No",1:" ")
  12721   "RTN","RCD PESP",105, 0)
  12722    K DIR S D IR(0)="YA" ,DIR("B")= $S(APPC="" :"Yes",1:A PPC)
  12723   "RTN","RCD PESP",106, 0)
  12724    S DIR("A" )=$$GET1^D ID(344.61, 1.01,,"TIT LE")
  12725   "RTN","RCD PESP",107, 0)
  12726    S DIR("?" )=$$GET1^D ID(344.61, 1.01,,"HEL P-PROMPT")
  12727   "RTN","RCD PESP",108, 0)
  12728    D ^DIR I  $D(DTOUT)! $D(DUOUT)  G ABORT
  12729   "RTN","RCD PESP",109, 0)
  12730    I APPCT'= Y D  ; use r updated  value
  12731   "RTN","RCD PESP",110, 0)
  12732    . S FDAED I(344.61," 1,",1.01)= Y D FILE^D IE(,"FDAED I") K FDAE DI
  12733   "RTN","RCD PESP",111, 0)
  12734    . D NOTIF Y($S(Y=1:" Yes",Y=0:" No",1:"*mi ssing*"),1 )
  12735   "RTN","RCD PESP",112, 0)
  12736    . S RCAUD VAL(1)="34 4.61^1.01^ 1^"_Y_U_(' Y) D AUDIT (.RCAUDVAL ) K RCAUDV AL
  12737   "RTN","RCD PESP",113, 0)
  12738    ;
  12739   "RTN","RCD PESP",114, 0)
  12740    ; If yes,  set/Reset  payer exc lusions fo r pharmacy  claims po sting
  12741   "RTN","RCD PESP",115, 0)
  12742    I Y=1 D   G:$G(RCQUI T)=1 ABORT
  12743   "RTN","RCD PESP",116, 0)
  12744    . D EXCLL IST(3) ; D isplay the  exclusion  list
  12745   "RTN","RCD PESP",117, 0)
  12746    . D SETEX CL(3) Q:$G (RCQUIT)   ; SET/RESE T exclusio ns
  12747   "RTN","RCD PESP",118, 0)
  12748    . D EXCLL IST(3) ; D isplay the  exclusion  list
  12749   "RTN","RCD PESP",119, 0)
  12750    . W !
  12751   "RTN","RCD PESP",120, 0)
  12752    ;
  12753   "RTN","RCD PESP",121, 0)
  12754    ; Show Ph armacy pro mpt but do n't allow  change
  12755   "RTN","RCD PESP",122, 0)
  12756    D:$$GET1^ DIQ(344.61 ,"1,",1.01 ,"I")=1  G :$G(RCQUIT )=1 ABORT
  12757   "RTN","RCD PESP",123, 0)
  12758    . W !,"EN ABLE AUTO- DECREASE O F PHARMACY  CLAIMS (Y /N): NO//"
  12759   "RTN","RCD PESP",124, 0)
  12760    . W !,"    Determine s if auto- decrease o f pharmacy  claims ar e enabled  for this s ite."
  12761   "RTN","RCD PESP",125, 0)
  12762    . W !,"    NOTE:  No t editable  and set t o Disabled  until fur ther notic e.",!
  12763   "RTN","RCD PESP",126, 0)
  12764    . K DIR S  DIR(0)="E A"
  12765   "RTN","RCD PESP",127, 0)
  12766    . S DIR(" A")="Press  Enter to  continue:  "
  12767   "RTN","RCD PESP",128, 0)
  12768    . D ^DIR  I $D(DTOUT )!$D(DUOUT ) S RCQUIT =1
  12769   "RTN","RCD PESP",129, 0)
  12770    . W !
  12771   "RTN","RCD PESP",130, 0)
  12772    ;
  12773   "RTN","RCD PESP",131, 0)
  12774    ; ^DD(344 .61,.06,0)  = MEDICAL  EFT POST  PREVENT DA YS
  12775   "RTN","RCD PESP",132, 0)
  12776    N MEO S M EO=$$GET1^ DIQ(344.61 ,"1,",.06)
  12777   "RTN","RCD PESP",133, 0)
  12778    K DIR S:M EO]"" DIR( "B")=MEO
  12779   "RTN","RCD PESP",134, 0)
  12780    S DIR("?" )=$$GET1^D ID(344.61, .06,,"HELP -PROMPT")
  12781   "RTN","RCD PESP",135, 0)
  12782    S DIR(0)= "NA^14:60: 0",DIR("A" )=$$GET1^D ID(344.61, .06,,"TITL E") ; PRCA *4.5*321 C hange max  from 99 to  60
  12783   "RTN","RCD PESP",136, 0)
  12784    D ^DIR I  $D(DTOUT)! $D(DUOUT)  G ABORT
  12785   "RTN","RCD PESP",137, 0)
  12786    I MEO'=Y  D  ; updat e and audi t
  12787   "RTN","RCD PESP",138, 0)
  12788    . S RCAUD VAL(1)="34 4.61^.06^1 ^"_Y_U_MEO
  12789   "RTN","RCD PESP",139, 0)
  12790    . S FDAED I(344.61," 1,",.06)=Y  D FILE^DI E(,"FDAEDI ")
  12791   "RTN","RCD PESP",140, 0)
  12792    . D AUDIT (.RCAUDVAL ) K RCAUDV AL
  12793   "RTN","RCD PESP",141, 0)
  12794    ;
  12795   "RTN","RCD PESP",142, 0)
  12796    ; (#.07)  PHARMACY E FT POST PR EVENT DAYS  [7N]
  12797   "RTN","RCD PESP",143, 0)
  12798    N PEO S P EO=$$GET1^ DIQ(344.61 ,"1,",.07)
  12799   "RTN","RCD PESP",144, 0)
  12800    K DIR S:P EO]"" DIR( "B")=PEO
  12801   "RTN","RCD PESP",145, 0)
  12802    S DIR("?" )=$$GET1^D ID(344.61, .07,,"HELP -PROMPT")
  12803   "RTN","RCD PESP",146, 0)
  12804    S DIR(0)= "NA^21:99: 0",DIR("A" )=$$GET1^D ID(344.61, .07,,"TITL E") ; PRCA *4.5*332 C hange max  from 365 T O 99
  12805   "RTN","RCD PESP",147, 0)
  12806    D ^DIR I  $D(DTOUT)! $D(DUOUT)  G ABORT
  12807   "RTN","RCD PESP",148, 0)
  12808    I PEO'=Y  D  ; updat e and audi t
  12809   "RTN","RCD PESP",149, 0)
  12810    . S RCAUD VAL(1)="34 4.61^.07^1 ^"_Y_U_PEO
  12811   "RTN","RCD PESP",150, 0)
  12812    . S FDAED I(344.61," 1,",.07)=Y  D FILE^DI E(,"FDAEDI ")
  12813   "RTN","RCD PESP",151, 0)
  12814    . D AUDIT (.RCAUDVAL ) K RCAUDV AL
  12815   "RTN","RCD PESP",152, 0)
  12816    ;
  12817   "RTN","RCD PESP",153, 0)
  12818    ; (#.13)  TRICARE EF T POST PRE VENT DAYS  [13N] - PR CA*4.5*332
  12819   "RTN","RCD PESP",154, 0)
  12820    N PEO S P EO=$$GET1^ DIQ(344.61 ,"1,",.13)
  12821   "RTN","RCD PESP",155, 0)
  12822    K DIR
  12823   "RTN","RCD PESP",156, 0)
  12824    S:PEO]""  DIR("B")=P EO
  12825   "RTN","RCD PESP",157, 0)
  12826    S DIR("?" )=$$GET1^D ID(344.61, .13,,"HELP -PROMPT")
  12827   "RTN","RCD PESP",158, 0)
  12828    S DIR(0)= "NA^14:60: 0",DIR("A" )=$$GET1^D ID(344.61, .13,,"TITL E")_" "
  12829   "RTN","RCD PESP",159, 0)
  12830    D ^DIR
  12831   "RTN","RCD PESP",160, 0)
  12832    I $D(DTOU T)!$D(DUOU T) D ABORT  Q
  12833   "RTN","RCD PESP",161, 0)
  12834    I PEO'=Y  D  ; Updat e and audi t
  12835   "RTN","RCD PESP",162, 0)
  12836    . S RCAUD VAL(1)="34 4.61^.13^1 ^"_Y_U_PEO
  12837   "RTN","RCD PESP",163, 0)
  12838    . S FDAED I(344.61," 1,",.13)=Y  D FILE^DI E(,"FDAEDI ")
  12839   "RTN","RCD PESP",164, 0)
  12840    . D AUDIT (.RCAUDVAL ) K RCAUDV AL
  12841   "RTN","RCD PESP",165, 0)
  12842    ;
  12843   "RTN","RCD PESP",166, 0)
  12844    G EXIT
  12845   "RTN","RCD PESP",167, 0)
  12846    ;
  12847   "RTN","RCD PESP",168, 0)
  12848   ABORT ; Ca lled when  user enter s a '^' or  times out
  12849   "RTN","RCD PESP",169, 0)
  12850    ; fall th rough to E XIT
  12851   "RTN","RCD PESP",170, 0)
  12852    ;
  12853   "RTN","RCD PESP",171, 0)
  12854   EXIT ; Unl ock, ask u ser to pre ss return,  exit
  12855   "RTN","RCD PESP",172, 0)
  12856    D EXIT^RC DPESP6 ; P RCA*4.5*32 6 - Send m ail messag e if param eters have  been edit ed.
  12857   "RTN","RCD PESP",173, 0)
  12858    L -^RCY(3 44.61,1)
  12859   "RTN","RCD PESP",174, 0)
  12860    D PAUSE
  12861   "RTN","RCD PESP",175, 0)
  12862    Q
  12863   "RTN","RCD PESP",176, 0)
  12864    ;
  12865   "RTN","RCD PESP",177, 0)
  12866   PAUSE ; pr ompt user  to press r eturn
  12867   "RTN","RCD PESP",178, 0)
  12868    W ! N DIR
  12869   "RTN","RCD PESP",179, 0)
  12870    S DIR("T" )=3,DIR(0) ="E",DIR(" A")="Press  RETURN to  continue"  D ^DIR
  12871   "RTN","RCD PESP",180, 0)
  12872    Q
  12873   "RTN","RCD PESP",181, 0)
  12874    ;
  12875   "RTN","RCD PESP",182, 0)
  12876   COUNT(TYPE ) ; Count  active CAR Cs in file  344.62 (R CDPE CARC- RARC AUTO  DEC)
  12877   "RTN","RCD PESP",183, 0)
  12878    N NUM,I
  12879   "RTN","RCD PESP",184, 0)
  12880    I (TYPE'= 1)&(TYPE'= 0) Q 0  ;  If TYPE is  not activ e (1) or i n-active ( 0) quit wi th count =  0
  12881   "RTN","RCD PESP",185, 0)
  12882    S NUM=0
  12883   "RTN","RCD PESP",186, 0)
  12884    S I="" F   S I=$O(^R CY(344.62, "ACTV",TYP E,I)) Q:I= ""  S NUM= NUM+1
  12885   "RTN","RCD PESP",187, 0)
  12886    Q NUM
  12887   "RTN","RCD PESP",188, 0)
  12888    ;
  12889   "RTN","RCD PESP",189, 0)
  12890   EXCLLIST(T YP) ; CHOI CE determi nes which  exclusions  to list
  12891   "RTN","RCD PESP",190, 0)
  12892    ; TYP - T YPE OF EXL USION - RE QUIRED
  12893   "RTN","RCD PESP",191, 0)
  12894    ; IX - wh ich index  to use
  12895   "RTN","RCD PESP",192, 0)
  12896    ; IEN - p oints to a n excluded  payer for  the selec ted choice
  12897   "RTN","RCD PESP",193, 0)
  12898    Q:'("^1^2 ^3^"[(U_$G (TYP)_U))   ; one or  two only
  12899   "RTN","RCD PESP",194, 0)
  12900    N IX,IEN, CT,LIST S  (IEN,CT)=0  W !
  12901   "RTN","RCD PESP",195, 0)
  12902    S IX=$S(T YP=1:"EXMD POST",TYP= 2:"EXMDDEC R",TYP=3:" EXRXPOST", 1:"") ;,TY P=4:"EXRXD ECR",1:"")
  12903   "RTN","RCD PESP",196, 0)
  12904    S LIST=$S (TYP=1:"", TYP=3:"",1 :"** Addit ional ")_" Payers exc luded from  "_$S(TYP= 1:"Medical  Auto-Post ing:",TYP= 3:"Pharmac y Auto-Pos ting",1:"M edical Aut o-Decrease :")
  12905   "RTN","RCD PESP",197, 0)
  12906    F  S IEN= $O(^RCY(34 4.6,IX,1,I EN)) Q:'IE N  D
  12907   "RTN","RCD PESP",198, 0)
  12908    . S CT=CT +1
  12909   "RTN","RCD PESP",199, 0)
  12910    . W:CT=1  !,LIST
  12911   "RTN","RCD PESP",200, 0)
  12912    . W !,"   "_$P(^RCY( 344.6,IEN, 0),U,1)_"  "_$P(^RCY( 344.6,IEN, 0),U,2)
  12913   "RTN","RCD PESP",201, 0)
  12914    ;
  12915   "RTN","RCD PESP",202, 0)
  12916    I TYP=2 W  !,"All pa yers exclu ded from A uto-Postin g are also  excluded  from Auto- Decrease."
  12917   "RTN","RCD PESP",203, 0)
  12918    W:CT=0 !, "   No "_$ S(TYP=2:"a dditional  ",1:"")_"p ayers excl uded from  "_$S(TYP=1 :"Medical  Auto-Posti ng:",TYP=3 :"Pharmacy  Auto-Post ing",1:"Me dical Auto -Decrease: ")
  12919   "RTN","RCD PESP",204, 0)
  12920    ; if list  is for au to-decreas e and ther e are excl usions wri te a messa ge
  12921   "RTN","RCD PESP",205, 0)
  12922    Q
  12923   "RTN","RCD PESP",206, 0)
  12924    ;
  12925   "RTN","RCD PESP",207, 0)
  12926   SETEXCL(TY P) ; LOOP  FOR SETTIN G PAYER EX CLUSIONS
  12927   "RTN","RCD PESP",208, 0)
  12928    ; TYP - T YPE OF EXL USION - RE QUIRED
  12929   "RTN","RCD PESP",209, 0)
  12930    N CMT,CT, DIC,DIR,DO NE,FDAPAYE R,FLD,IEN, PREC,RCAUD VAL,RTYP,X ,Y
  12931   "RTN","RCD PESP",210, 0)
  12932    ; FDAPAYE R - FDA FO R FILE 344 .6
  12933   "RTN","RCD PESP",211, 0)
  12934    ; FLD - F IELD BEING  MODIFIED
  12935   "RTN","RCD PESP",212, 0)
  12936    ; RTYP -  STRING REP RESENTING  FIELD
  12937   "RTN","RCD PESP",213, 0)
  12938    ; DONE -  INDICATOR  TO LEAVE L OOP
  12939   "RTN","RCD PESP",214, 0)
  12940    ; RCAUDVA L - ARRAY  FOR AUDITI NG
  12941   "RTN","RCD PESP",215, 0)
  12942    ; PREC -  HOLDER FOR  Y(0) AFTE R ^DIC CAL L
  12943   "RTN","RCD PESP",216, 0)
  12944    ;          FILE NUMB ER^FIELD N UMBER^IEN^ NEW VALUE^ OLD VALUE, COMMENT
  12945   "RTN","RCD PESP",217, 0)
  12946    I $G(TYP) =1 S FLD=. 06,CMT=1,R TYP="MEDIC AL CLAIMS  POSTING"
  12947   "RTN","RCD PESP",218, 0)
  12948    I $G(TYP) =2 S FLD=. 07,CMT=2,R TYP="MEDIC AL CLAIMS  DECREASE"
  12949   "RTN","RCD PESP",219, 0)
  12950    I $G(TYP) =3 S FLD=. 08,CMT=3,R TYP="PHARM ACY CLAIMS  POSTING"
  12951   "RTN","RCD PESP",220, 0)
  12952    I '$D(FLD ) Q 
  12953   "RTN","RCD PESP",221, 0)
  12954    ;
  12955   "RTN","RCD PESP",222, 0)
  12956    W !!,"Sel ect a Paye r to add o r remove f rom the ex clusion li st.",!
  12957   "RTN","RCD PESP",223, 0)
  12958    S (RCQUIT ,CT,DONE)= 0 F  Q:DON E!RCQUIT   D
  12959   "RTN","RCD PESP",224, 0)
  12960    . S DIC=" ^RCY(344.6 ,",DIC(0)= "AEMQZ",DI C("A")="Pa yer: " D ^ DIC I X="^ " S RCQUIT =1 Q
  12961   "RTN","RCD PESP",225, 0)
  12962    . I +$G(Y )<1 S DONE =1 Q
  12963   "RTN","RCD PESP",226, 0)
  12964    . S CT=CT +1,IEN=+Y, IENS=IEN_" ,",PREC=Y( 0)
  12965   "RTN","RCD PESP",227, 0)
  12966    . K FDAPA YER
  12967   "RTN","RCD PESP",228, 0)
  12968    . N COMME NT,STAT
  12969   "RTN","RCD PESP",229, 0)
  12970    . S COMME NT="",STAT ='$$GET1^D IQ(344.6,I ENS,FLD,"I ")
  12971   "RTN","RCD PESP",230, 0)
  12972    . S FDAPA YER(344.6, IENS,FLD)= STAT
  12973   "RTN","RCD PESP",231, 0)
  12974    . ; GET C OMMENT HER E
  12975   "RTN","RCD PESP",232, 0)
  12976    . K Y S D IR("A")="C OMMENT: ", DIR(0)="FA ^3:72"
  12977   "RTN","RCD PESP",233, 0)
  12978    . S DIR(" PRE")="S X =$$TRIM^XL FSTR(X,""L R"")" ; co mment requ ired and s hould be s ignificant
  12979   "RTN","RCD PESP",234, 0)
  12980    . S DIR(" ?")="Enter  an explan ation for  "_$S(STAT: "adding th e payer to ",1:"remov ing the pa yer from") _" the lis t of Exclu ded Payers ."
  12981   "RTN","RCD PESP",235, 0)
  12982    . D ^DIR  I $D(DTOUT )!$D(DUOUT )!(Y="") S  RCQUIT=1  Q
  12983   "RTN","RCD PESP",236, 0)
  12984    . S COMME NT=Y
  12985   "RTN","RCD PESP",237, 0)
  12986    . I COMME NT]"" D
  12987   "RTN","RCD PESP",238, 0)
  12988    ..  S FDA PAYER(344. 6,IENS,CMT )=$S(STAT: COMMENT,1: "")
  12989   "RTN","RCD PESP",239, 0)
  12990    ..  W !,$ P(PREC,U)_ " "_$P(PRE C,U,2)_" h as been "
  12991   "RTN","RCD PESP",240, 0)
  12992    ..  W $S( STAT:"adde d to",1:"r emoved fro m")_" the  list of Ex cluded Pay ers"
  12993   "RTN","RCD PESP",241, 0)
  12994    ..  I TYP =1 D
  12995   "RTN","RCD PESP",242, 0)
  12996    ...   W ! ,"If medic al auto-de crease is  turned on,  "
  12997   "RTN","RCD PESP",243, 0)
  12998    ...   I S TAT W "thi s payer wi ll be excl uded from  medical au to-decreas e too."
  12999   "RTN","RCD PESP",244, 0)
  13000    ...   I ' STAT,'$$GE T1^DIQ(344 .6,IEN_"," ,.07,"I")  W "this pa yer will n o longer b e excluded  from Medi cal Auto-D ecrease."
  13001   "RTN","RCD PESP",245, 0)
  13002    ...   I ' STAT,$$GET 1^DIQ(344. 6,IEN_",", .07,"I") W  "Medical  Auto-Decre ase is set  to be exc luded for  this payer ."
  13003   "RTN","RCD PESP",246, 0)
  13004    ..  K RCA UDVAL
  13005   "RTN","RCD PESP",247, 0)
  13006    ..  D FIL E^DIE(,"FD APAYER")
  13007   "RTN","RCD PESP",248, 0)
  13008    ..  S RCA UDVAL(1)=" 344.6"_U_F LD_U_IEN_U _STAT_U_(' STAT)_U_CO MMENT
  13009   "RTN","RCD PESP",249, 0)
  13010    ..  D AUD IT(.RCAUDV AL) K RCAU DVAL
  13011   "RTN","RCD PESP",250, 0)
  13012    Q
  13013   "RTN","RCD PESP",251, 0)
  13014    ;
  13015   "RTN","RCD PESP",252, 0)
  13016   NOTIFY(VAL ,TYPE) ; N otify CBO  team of ch ange to Si te Paramet ers
  13017   "RTN","RCD PESP",253, 0)
  13018    N GLB,GLO ,MSG,SITE, SUBJ,XMINS TR,XMTO
  13019   "RTN","RCD PESP",254, 0)
  13020    S SITE=$$ SITE^VASIT E
  13021   "RTN","RCD PESP",255, 0)
  13022    S TYPE=+$ G(TYPE)  ; init optio nal parame ter
  13023   "RTN","RCD PESP",256, 0)
  13024    ; limit s ubject to  65 chars.
  13025   "RTN","RCD PESP",257, 0)
  13026    S SUBJ=$E ("Site Par ameter edi t, Station  #"_$P(SIT E,U,3)_" -  "_$P(SITE ,U,2),1,65 )
  13027   "RTN","RCD PESP",258, 0)
  13028    S MSG(1)= " "
  13029   "RTN","RCD PESP",259, 0)
  13030    S MSG(2)= "        S ite: "_$P( SITE,U,2)
  13031   "RTN","RCD PESP",260, 0)
  13032    S MSG(3)= "   Statio n #: "_$P( SITE,U,3)
  13033   "RTN","RCD PESP",261, 0)
  13034    S MSG(4)= "      Dom ain: "_$G( ^XMB("NETN AME"))
  13035   "RTN","RCD PESP",262, 0)
  13036    S MSG(5)= "   Date/T ime: "_$$F MTE^XLFDT( $$NOW^XLFD T,"5ZPM")
  13037   "RTN","RCD PESP",263, 0)
  13038    S MSG(6)= "  Changed  by: "_$P( $G(^VA(200 ,DUZ,0)),U )
  13039   "RTN","RCD PESP",264, 0)
  13040    S MSG(7)= " "
  13041   "RTN","RCD PESP",265, 0)
  13042    S MSG(8)= "  ENABLE  AUTO-POSTI NG OF "_$S (TYPE=1:"P HARMACY",1 :"MEDICAL" )_" CLAIMS  = "_VAL
  13043   "RTN","RCD PESP",266, 0)
  13044    S MSG(9)= " "
  13045   "RTN","RCD PESP",267, 0)
  13046    ;Copy mes sage to eP ayments CB O team
  13047   "RTN","RCD PESP",268, 0)
  13048    S XMTO(DU Z)=""
  13049   "RTN","RCD PESP",269, 0)
  13050    ; S:$$PRO D^XUPROD X MTO("
P II                   ")="" ; PR CA*4.5*326  autopost  on/off mes sage no lo nger requi red by ePa y
  13051   "RTN","RCD PESP",270, 0)
  13052    ;
  13053   "RTN","RCD PESP",271, 0)
  13054    K ^TMP("X MERR",$J)
  13055   "RTN","RCD PESP",272, 0)
  13056    D SENDMSG ^XMXAPI(DU Z,SUBJ,"MS G",.XMTO,. XMINSTR)
  13057   "RTN","RCD PESP",273, 0)
  13058    ;
  13059   "RTN","RCD PESP",274, 0)
  13060    I $D(^TMP ("XMERR",$ J)) D
  13061   "RTN","RCD PESP",275, 0)
  13062    .D MES^XP DUTL("Mail Man report ed a probl em trying  to send th e notifica tion messa ge.")
  13063   "RTN","RCD PESP",276, 0)
  13064    .D MES^XP DUTL("  ")
  13065   "RTN","RCD PESP",277, 0)
  13066    .S (GLO,G LB)="^TMP( ""XMERR"", "_$J
  13067   "RTN","RCD PESP",278, 0)
  13068    .S GLO=GL O_")"
  13069   "RTN","RCD PESP",279, 0)
  13070    .F  S GLO =$Q(@GLO)  Q:GLO'[GLB   D MES^XP DUTL("   " _GLO_" = " _$G(@GLO))
  13071   "RTN","RCD PESP",280, 0)
  13072    .D MES^XP DUTL("  ")
  13073   "RTN","RCD PESP",281, 0)
  13074    Q
  13075   "RTN","RCD PESP",282, 0)
  13076    ;
  13077   "RTN","RCD PESP",283, 0)
  13078   AUDIT(INP)  ; WRITE A UDIT RECOR D(S)
  13079   "RTN","RCD PESP",284, 0)
  13080    ; INP = a udit value  in this f ormat:
  13081   "RTN","RCD PESP",285, 0)
  13082    ;       F ILE NUMBER ^FIELD NUM BER^IEN^NE W VALUE^OL D VALUE^CO MMENT
  13083   "RTN","RCD PESP",286, 0)
  13084    Q:'$O(INP (0))   ; n othing to  audit
  13085   "RTN","RCD PESP",287, 0)
  13086    N FDAUDT   ; FileMan  FDA array  for audit s
  13087   "RTN","RCD PESP",288, 0)
  13088    N IDX S I DX=0
  13089   "RTN","RCD PESP",289, 0)
  13090    F  S IDX= $O(INP(IDX )) Q:'IDX   D
  13091   "RTN","RCD PESP",290, 0)
  13092    . K FDAUD T
  13093   "RTN","RCD PESP",291, 0)
  13094    . S FDAUD T(344.7,"+ 1,",.01)=$ $NOW^XLFDT
  13095   "RTN","RCD PESP",292, 0)
  13096    . S FDAUD T(344.7,"+ 1,",.02)=$ P(INP(IDX) ,U,3) ; IE N
  13097   "RTN","RCD PESP",293, 0)
  13098    . S FDAUD T(344.7,"+ 1,",.03)=D UZ  ; user
  13099   "RTN","RCD PESP",294, 0)
  13100    . S FDAUD T(344.7,"+ 1,",.04)=$ P(INP(IDX) ,U,2) ; FI ELD NUMBER
  13101   "RTN","RCD PESP",295, 0)
  13102    . S FDAUD T(344.7,"+ 1,",.05)=$ P(INP(IDX) ,U,1) ; FI LE NUMBER
  13103   "RTN","RCD PESP",296, 0)
  13104    . S FDAUD T(344.7,"+ 1,",.06)=$ P(INP(IDX) ,U,4) ; NE W VALUE
  13105   "RTN","RCD PESP",297, 0)
  13106    . S FDAUD T(344.7,"+ 1,",.07)=$ P(INP(IDX) ,U,5) ; OL D VALUE
  13107   "RTN","RCD PESP",298, 0)
  13108    . S FDAUD T(344.7,"+ 1,",.08)=$ P(INP(IDX) ,U,6) ; CO MMENT
  13109   "RTN","RCD PESP",299, 0)
  13110    . D UPDAT E^DIE(,"FD AUDT")
  13111   "RTN","RCD PESP",300, 0)
  13112    Q
  13113   "RTN","RCD PESP",301, 0)
  13114    ;
  13115   "RTN","RCD PESP",302, 0)
  13116    ; ******* ********** ********** ********** ********** ********** ****
  13117   "RTN","RCD PESP",303, 0)
  13118    ; CALLS R ELATED TO  CREATING E PAYMENT PA YER EXCLUS ION PARAME TERS
  13119   "RTN","RCD PESP",304, 0)
  13120    ; ******* ********** ********** ********** ********** ********** ****
  13121   "RTN","RCD PESP",305, 0)
  13122    ;
  13123   "RTN","RCD PESP",306, 0)
  13124   NEWPYR ;Ad d new paye rs to paye r table -  called fro m AR Night ly Job (EN ^RCDPEM)
  13125   "RTN","RCD PESP",307, 0)
  13126    N RCDATE, RCERA,RCUP D
  13127   "RTN","RCD PESP",308, 0)
  13128    ;Get date /time of l ast run ot herwise st art at pre vious day
  13129   "RTN","RCD PESP",309, 0)
  13130    S RCDATE= $P($G(^RCY (344.61,1, 0)),U,8) S :RCDATE=""  RCDATE=$$ FMADD^XLFD T($$NOW^XL FDT\1,-1)
  13131   "RTN","RCD PESP",310, 0)
  13132    F  S RCDA TE=$O(^RCY (344.4,"AF D",RCDATE) ) Q:'RCDAT E  D
  13133   "RTN","RCD PESP",311, 0)
  13134    .S RCERA= "" F  S RC ERA=$O(^RC Y(344.4,"A FD",RCDATE ,RCERA)) Q :'RCERA  S  RCUPD=$$P AYRINIT(RC ERA)
  13135   "RTN","RCD PESP",312, 0)
  13136    ;Update l ast run da te
  13137   "RTN","RCD PESP",313, 0)
  13138    S $P(^RCY (344.61,1, 0),U,8)=$$ NOW^XLFDT
  13139   "RTN","RCD PESP",314, 0)
  13140    Q
  13141   "RTN","RCD PESP",315, 0)
  13142    ;
  13143   "RTN","RCD PESP",316, 0)
  13144   PAYERPRM(I EN,EXMDPOS T,EXMDDECR ) ; USED T O UPDATE A  NEW PAYER
  13145   "RTN","RCD PESP",317, 0)
  13146    ; CHECK I EN FOR VAL ID INPUT
  13147   "RTN","RCD PESP",318, 0)
  13148    Q:'$G(IEN )!('$D(^RC Y(344.4,+$ G(IEN),0)) ) 0
  13149   "RTN","RCD PESP",319, 0)
  13150    N PFDA,PA YER,ID,C DNS     D,PIENS
  13151   "RTN","RCD PESP",320, 0)
  13152    S PAYER=$ E($$GET1^D IQ(344.4,I EN_",",.06 ),1,35)
  13153   "RTN","RCD PESP",321, 0)
  13154    Q:PAYER=" " 0
  13155   "RTN","RCD PESP",322, 0)
  13156    S ID=$E($ $GET1^DIQ( 344.4,IEN_ ",",.03),1 ,30)
  13157   "RTN","RCD PESP",323, 0)
  13158    I '$D(^RC Y(344.6,"C PID",PAYER ,ID)) Q 0
  13159   "RTN","RCD PESP",324, 0)
  13160    ; FILE CU RRENT SETT INGS
  13161   "RTN","RCD PESP",325, 0)
  13162    S PIENS=$ O(^RCY(344 .6,"CPID", PAYER,ID,0 ))_","
  13163   "RTN","RCD PESP",326, 0)
  13164    S PFDA(34 4.6,PIENS, .04)=DUZ
  13165   "RTN","RCD PESP",327, 0)
  13166    S PFDA(34 4.6,PIENS, .05)=$$NOW ^XLFDT
  13167   "RTN","RCD PESP",328, 0)
  13168    S PFDA(34 4.6,PIENS, .06)=+$G(E XMDPOST)
  13169   "RTN","RCD PESP",329, 0)
  13170    S PFDA(34 4.6,PIENS, .07)=+$G(E XMDDECR)
  13171   "RTN","RCD PESP",330, 0)
  13172    D FILE^DI E(,"PFDA")
  13173   "RTN","RCD PESP",331, 0)
  13174    Q 1
  13175   "RTN","RCD PESP",332, 0)
  13176    ;
  13177   "RTN","RCD PESP",333, 0)
  13178   PAYRINIT(I EN) ; Add  Payer Name  and Payer  ID to Pay er table # 344.6 
  13179   "RTN","RCD PESP",334, 0)
  13180    ;
  13181   "RTN","RCD PESP",335, 0)
  13182    N PFDA,PA YER,ID,PIE NS,ERADATE
  13183   "RTN","RCD PESP",336, 0)
  13184    ;
  13185   "RTN","RCD PESP",337, 0)
  13186    Q:'$G(IEN )!('$D(^RC Y(344.4,+$ G(IEN))))  0
  13187   "RTN","RCD PESP",338, 0)
  13188    S PAYER=$ P($G(^RCY( 344.4,IEN, 0)),U,6) Q :PAYER=""  0
  13189   "RTN","RCD PESP",339, 0)
  13190    S ID=$P($ G(^RCY(344 .4,IEN,0)) ,U,3) Q:ID ="" 0
  13191   "RTN","RCD PESP",340, 0)
  13192    I $D(^RCY (344.6,"CP ID",PAYER, ID)) Q 1
  13193   "RTN","RCD PESP",341, 0)
  13194    S ERADATE =$P($G(^RC Y(344.4,IE N,0)),U,7)
  13195   "RTN","RCD PESP",342, 0)
  13196    ; UPDATE  PAYER PARA METERS
  13197   "RTN","RCD PESP",343, 0)
  13198    S PIENS=" +1,"
  13199   "RTN","RCD PESP",344, 0)
  13200    S PFDA(34 4.6,PIENS, .01)=PAYER
  13201   "RTN","RCD PESP",345, 0)
  13202    S PFDA(34 4.6,PIENS, .02)=ID
  13203   "RTN","RCD PESP",346, 0)
  13204    S PFDA(34 4.6,PIENS, .03)=ERADA TE
  13205   "RTN","RCD PESP",347, 0)
  13206    S PFDA(34 4.6,PIENS, .04)=.5
  13207   "RTN","RCD PESP",348, 0)
  13208    S PFDA(34 4.6,PIENS, .05)=$$NOW ^XLFDT
  13209   "RTN","RCD PESP",349, 0)
  13210    S PFDA(34 4.6,PIENS, .06)=0
  13211   "RTN","RCD PESP",350, 0)
  13212    S PFDA(34 4.6,PIENS, .07)=0
  13213   "RTN","RCD PESP",351, 0)
  13214    D UPDATE^ DIE(,"PFDA ")
  13215   "RTN","RCD PESP",352, 0)
  13216    Q 1
  13217   "RTN","RCD PESP",353, 0)
  13218    ;
  13219   "RTN","RCD PESP1")
  13220   0^21^B1138 71339
  13221   "RTN","RCD PESP1",1,0 )
  13222   RCDPESP1 ; BIRM/SAB,h rubovcak -  ePayment  Lockbox Si te Paramet er Reports  ;27 Nov 2 018 09:10: 16
  13223   "RTN","RCD PESP1",2,0 )
  13224    ;;4.5;Acc ounts Rece ivable;**2 98,304,318 ,321,326,3 32**;Mar 2 0, 1995;Bu ild 34
  13225   "RTN","RCD PESP1",3,0 )
  13226    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  13227   "RTN","RCD PESP1",4,0 )
  13228    ;
  13229   "RTN","RCD PESP1",5,0 )
  13230    Q
  13231   "RTN","RCD PESP1",6,0 )
  13232    ;
  13233   "RTN","RCD PESP1",7,0 )
  13234   RPT ; EDI  Lockbox Pa rameters R eport [RCD PE SITE PA RAMETER RE PORT]
  13235   "RTN","RCD PESP1",8,0 )
  13236    ; report  data from:
  13237   "RTN","RCD PESP1",9,0 )
  13238    ;    AR S ITE PARAME TER file ( #342)
  13239   "RTN","RCD PESP1",10, 0)
  13240    ;    RCDP E PARAMETE R file (#3 44.61)
  13241   "RTN","RCD PESP1",11, 0)
  13242    ;    RCDP E AUTO-PAY  EXCLUSION  file (#34 4.6)
  13243   "RTN","RCD PESP1",12, 0)
  13244    ;
  13245   "RTN","RCD PESP1",13, 0)
  13246    ; LOCAL V ARIABLES:
  13247   "RTN","RCD PESP1",14, 0)
  13248    ;    RTYP E - Type o f Report t o run (Med ical, Phar macy, or B oth)
  13249   "RTN","RCD PESP1",15, 0)
  13250    ;
  13251   "RTN","RCD PESP1",16, 0)
  13252    N RCTYPE
  13253   "RTN","RCD PESP1",17, 0)
  13254    W !,$$HDR LN,!
  13255   "RTN","RCD PESP1",18, 0)
  13256    ;
  13257   "RTN","RCD PESP1",19, 0)
  13258    S RCTYPE= $$RTYPE^RC DPESP2() G :RCTYPE=-1  RPTQ
  13259   "RTN","RCD PESP1",20, 0)
  13260    W !!   ;S pacing bef ore the ne xt prompt
  13261   "RTN","RCD PESP1",21, 0)
  13262    ;
  13263   "RTN","RCD PESP1",22, 0)
  13264    N %ZIS,PO P S %ZIS=" QM" D ^%ZI S Q:POP
  13265   "RTN","RCD PESP1",23, 0)
  13266    I $D(IO(" Q")) D  Q
  13267   "RTN","RCD PESP1",24, 0)
  13268    .N ZTDESC ,ZTQUEUED, ZTRTN,ZTSA VE,ZTSK
  13269   "RTN","RCD PESP1",25, 0)
  13270    .S ZTRTN= "SPRPT^RCD PESP1",ZTD ESC=$$HDRL N,ZTSAVE(" RC*")=""
  13271   "RTN","RCD PESP1",26, 0)
  13272    .D ^%ZTLO AD
  13273   "RTN","RCD PESP1",27, 0)
  13274    .W !!,$S( $G(ZTSK):" Task numbe r "_ZTSK_"  has been  queued.",1 :"Unable t o queue th is task.")
  13275   "RTN","RCD PESP1",28, 0)
  13276    .K IO("Q" ) D HOME^% ZIS
  13277   "RTN","RCD PESP1",29, 0)
  13278    ;
  13279   "RTN","RCD PESP1",30, 0)
  13280    D SPRPT
  13281   "RTN","RCD PESP1",31, 0)
  13282   RPTQ Q
  13283   "RTN","RCD PESP1",32, 0)
  13284    ;
  13285   "RTN","RCD PESP1",33, 0)
  13286   SPRPT ; si te paramet er report  entry poin t
  13287   "RTN","RCD PESP1",34, 0)
  13288    ; RCNTR -  counter
  13289   "RTN","RCD PESP1",35, 0)
  13290    ; RCFLD -  DD field  number
  13291   "RTN","RCD PESP1",36, 0)
  13292    ; RCHDR -  header in formation
  13293   "RTN","RCD PESP1",37, 0)
  13294    ; RCPARM  - paramete rs
  13295   "RTN","RCD PESP1",38, 0)
  13296    ; RCSTOP  - exit fla g
  13297   "RTN","RCD PESP1",39, 0)
  13298    N J,RCACT V,RCCARCD, RCCIEN,RCC ODE,RCDATA ,RCDESC,RC FLD,RCGLB, RCHDR,RCI, RCITEM,RCN TR,RCPARM, RCSTAT,RCS TOP,RCSTRI NG,V,X,Y
  13299   "RTN","RCD PESP1",40, 0)
  13300    ;
  13301   "RTN","RCD PESP1",41, 0)
  13302    S X="RC"  F  S X=$O( ^TMP($J,X) ) Q:'($E(X ,1,2)="RC" )  K ^TMP( $J,X) ; cl ear out ol d data
  13303   "RTN","RCD PESP1",42, 0)
  13304    ;
  13305   "RTN","RCD PESP1",43, 0)
  13306    ; RCGLB -  ^TMP glob al storage  locations
  13307   "RTN","RCD PESP1",44, 0)
  13308    ;     ^TM P($J,"RC34 2") - AR S ITE PARAME TER file ( #342)
  13309   "RTN","RCD PESP1",45, 0)
  13310    ;   ^TMP( $J,"RC344. 6") - RCDP E AUTO-PAY  EXCLUSION  file (#34 4.6)
  13311   "RTN","RCD PESP1",46, 0)
  13312    ;  ^TMP($ J,"RC344.6 1") - RCDP E PARAMETE R file (#3 44.61)
  13313   "RTN","RCD PESP1",47, 0)
  13314    F J=342,3 44.6,344.6 1 S RCGLB( J)=$NA(^TM P($J,"RC"_ J)) K @RCG LB(J)
  13315   "RTN","RCD PESP1",48, 0)
  13316    ;
  13317   "RTN","RCD PESP1",49, 0)
  13318    S RCHDR(" RUNDATE")= $$FMTE^XLF DT($$NOW^X LFDT,"10S" )
  13319   "RTN","RCD PESP1",50, 0)
  13320    S RCHDR(" PGNMBR")=0   ; page n umber
  13321   "RTN","RCD PESP1",51, 0)
  13322    ;
  13323   "RTN","RCD PESP1",52, 0)
  13324    ; AR SITE  PARAMETER  file (#34 2)
  13325   "RTN","RCD PESP1",53, 0)
  13326    D GETS^DI Q(342,"1," ,".01;7.02 ;7.03;7.04 ;7.05;7.06 ;7.07;7.08 ;7.09;","E ",RCGLB(34 2))
  13327   "RTN","RCD PESP1",54, 0)
  13328    ; add sit e to heade r data
  13329   "RTN","RCD PESP1",55, 0)
  13330    S RCHDR(" SITE")="Si te: "_@RCG LB(342)@(3 42,"1,",.0 1,"E")
  13331   "RTN","RCD PESP1",56, 0)
  13332    ;
  13333   "RTN","RCD PESP1",57, 0)
  13334    F RCFLD=7 .02,7.03,7 .04,7.05,7 .06,7.07,7 .08,7.09 S  RCITEM=$S (RCFLD>7.0 4:"TITLE", 1:"LABEL")  D  ; EFT  and ERA da ys unmatch ed  - PRCA *4.5*321
  13335   "RTN","RCD PESP1",58, 0)
  13336    . I RCTYP E="P",(RCF LD=7.05)!( RCFLD=7.07 ) Q  ; Don 't display  if only s howing Pha rmacy para meters - P RCA*4.5*32 1
  13337   "RTN","RCD PESP1",59, 0)
  13338    . I RCTYP E="M",(RCF LD=7.06)!( RCFLD=7.08 ) Q  ; Don 't display  if only s howing med ical param eters - PR CA*4.5*321
  13339   "RTN","RCD PESP1",60, 0)
  13340    . S Y=$$G ET1^DID(34 2,RCFLD,,R CITEM)_":  "_@RCGLB(3 42)@(342," 1,",RCFLD, "E")
  13341   "RTN","RCD PESP1",61, 0)
  13342    . I RCFLD =7.05 D AD 2RPT(" ")
  13343   "RTN","RCD PESP1",62, 0)
  13344    . I (RCFL D=7.06)&(R CTYPE="P")  D AD2RPT( " ")
  13345   "RTN","RCD PESP1",63, 0)
  13346    . D AD2RP T(Y)
  13347   "RTN","RCD PESP1",64, 0)
  13348    ;
  13349   "RTN","RCD PESP1",65, 0)
  13350    D AD2RPT( " ")
  13351   "RTN","RCD PESP1",66, 0)
  13352    ;
  13353   "RTN","RCD PESP1",67, 0)
  13354    ; Display  Medical P arameters
  13355   "RTN","RCD PESP1",68, 0)
  13356    ; RCDPE P ARAMETER f ile (#344. 61)
  13357   "RTN","RCD PESP1",69, 0)
  13358    D GETS^DI Q(344.61," 1,",".02;. 03;.04;.05 ;.06;.07;. 1;.11;.12; .13;1.01;1 .02","E",R CGLB(344.6 1)) ; PRCA *4.5*321/P RCA*4.5*32 6/PRCA*4.5 *332
  13359   "RTN","RCD PESP1",70, 0)
  13360    ;
  13361   "RTN","RCD PESP1",71, 0)
  13362    S Y=$$GET 1^DID(344. 61,.1,,"LA BEL")_": " _@RCGLB(34 4.61)@(344 .61,"1,",. 1,"E") ; P RCA*4.5*32 1
  13363   "RTN","RCD PESP1",72, 0)
  13364    D AD2RPT( Y),AD2RPT( " ") ; PRC A*4.5*321
  13365   "RTN","RCD PESP1",73, 0)
  13366    ;
  13367   "RTN","RCD PESP1",74, 0)
  13368    ; get aut o-post and  auto-decr ease setti ngs, save  zero node
  13369   "RTN","RCD PESP1",75, 0)
  13370    S X=$G(^R CY(344.61, 1,0)),RCPA RM("AUTO-P OST")=$P(X ,U,2),RCPA RM("AUTO-D ECREASE")= $P(X,U,3), RCPARM(344 .61,0)=X
  13371   "RTN","RCD PESP1",76, 0)
  13372    S RCPARM( "RX AUTO-P OST")=$P($ G(^RCY(344 .61,1,1)), U)
  13373   "RTN","RCD PESP1",77, 0)
  13374    ;
  13375   "RTN","RCD PESP1",78, 0)
  13376    ; RCDPE A UTO-PAY EX CLUSION fi le (#344.6 )
  13377   "RTN","RCD PESP1",79, 0)
  13378    ;   scree ning logic : ^DD(344. 6,.06,0)=" EXCLUDE ME D CLAIMS P OSTING^S^0 :No;1:Yes; ^0;6^Q"
  13379   "RTN","RCD PESP1",80, 0)
  13380    D LIST^DI C(344.6,," @;.01;.02; .06;1","P" ,,,,,"I $P (^(0),U,6) =1",,RCGLB (344.6))
  13381   "RTN","RCD PESP1",81, 0)
  13382    ;
  13383   "RTN","RCD PESP1",82, 0)
  13384    ; PRCA*4. 5*304 - Pr int Medica l Claim Pa rameters
  13385   "RTN","RCD PESP1",83, 0)
  13386    I RCTYPE' ="P" D
  13387   "RTN","RCD PESP1",84, 0)
  13388    .; RCDPE  PARAMETER  file (#344 .61), auto -posting o f medical  claims
  13389   "RTN","RCD PESP1",85, 0)
  13390    .S X=$$GE T1^DID(344 .61,.02,," TITLE"),V= " (Y/N)" S :X[V X=$P( X,V)_$P(X, V,2)  ; re move yes/n o prompt
  13391   "RTN","RCD PESP1",86, 0)
  13392    .S Y=X_"  "_@RCGLB(3 44.61)@(34 4.61,"1,", .02,"E")
  13393   "RTN","RCD PESP1",87, 0)
  13394    .D AD2RPT (Y)
  13395   "RTN","RCD PESP1",88, 0)
  13396    .I (RCPAR M("AUTO-PO ST")!RCPAR M("AUTO-DE CREASE"))  D  ; list  auto-post  excluded p ayers
  13397   "RTN","RCD PESP1",89, 0)
  13398    ..I '$D(@ RCGLB(344. 6)@("DILIS T",1,0)) D   Q
  13399   "RTN","RCD PESP1",90, 0)
  13400    ...S X="      No pay ers exclud ed from me dical auto -posting."  D AD2RPT( $J(" ",80- $L(X)\2)_X )
  13401   "RTN","RCD PESP1",91, 0)
  13402    ..;
  13403   "RTN","RCD PESP1",92, 0)
  13404    ..D AD2RP T("   Excl uded Payer                         Comment" )
  13405   "RTN","RCD PESP1",93, 0)
  13406    ..S RCNTR =0
  13407   "RTN","RCD PESP1",94, 0)
  13408    ..F  S RC NTR=$O(@RC GLB(344.6) @("DILIST" ,RCNTR)) Q :'RCNTR  D
  13409   "RTN","RCD PESP1",95, 0)
  13410    ...S V=@R CGLB(344.6 )@("DILIST ",RCNTR,0) ,X=$E($P(V ,U,2),1,35 )
  13411   "RTN","RCD PESP1",96, 0)
  13412    ...S Y="    "_X_$J("  ",36-$L(X ))_$P(V,U, 5)
  13413   "RTN","RCD PESP1",97, 0)
  13414    ...D AD2R PT($E(Y,1, IOM))
  13415   "RTN","RCD PESP1",98, 0)
  13416    .;
  13417   "RTN","RCD PESP1",99, 0)
  13418    .I RCPARM ("AUTO-POS T") D AD2R PT(" ")
  13419   "RTN","RCD PESP1",100 ,0)
  13420    .;
  13421   "RTN","RCD PESP1",101 ,0)
  13422    .K @RCGLB (344.6)  ;  delete ol d data
  13423   "RTN","RCD PESP1",102 ,0)
  13424    .; RCDPE  AUTO-PAY E XCLUSION f ile (#344. 6)
  13425   "RTN","RCD PESP1",103 ,0)
  13426    .;   scre ening logi c: ^DD(344 .6,.07,0)= "EXCLUDE M ED CLAIMS  DECREASE^S ^0:No;1:Ye s;^0;7^Q"
  13427   "RTN","RCD PESP1",104 ,0)
  13428    .D LIST^D IC(344.6,, "@;.01;.02 ;.07;2","P ",,,,,"I $ P(^(0),U,7 )=1",,RCGL B(344.6))
  13429   "RTN","RCD PESP1",105 ,0)
  13430    .;
  13431   "RTN","RCD PESP1",106 ,0)
  13432    .; BEGIN  PRCA*4.5*3 26
  13433   "RTN","RCD PESP1",107 ,0)
  13434    .D AD2RPT (" ")
  13435   "RTN","RCD PESP1",108 ,0)
  13436    .; Displa y Auto-Dec rease para meters for  paid line s
  13437   "RTN","RCD PESP1",109 ,0)
  13438    .D AUTOD( 1,.RCGBL,R CTYPE)
  13439   "RTN","RCD PESP1",110 ,0)
  13440    .; Displa y Auto-Dec rease para meters for  no-pay li nes
  13441   "RTN","RCD PESP1",111 ,0)
  13442    .D AUTOD( 0,.RCGBL,R CTYPE)
  13443   "RTN","RCD PESP1",112 ,0)
  13444    .D AD2RPT (" ")
  13445   "RTN","RCD PESP1",113 ,0)
  13446    .; END PR CA*4.5*326
  13447   "RTN","RCD PESP1",114 ,0)
  13448    .I (RCPAR M("AUTO-PO ST")!RCPAR M("AUTO-DE CREASE"))  D  ; list  excluded a uto-decrea se payers
  13449   "RTN","RCD PESP1",115 ,0)
  13450    .. Q:'RCP ARM("AUTO- DECREASE")
  13451   "RTN","RCD PESP1",116 ,0)
  13452    .. D AD2R PT("     A ll payers  excluded f rom Auto-P osting are  excluded  from Auto- Decrease." )
  13453   "RTN","RCD PESP1",117 ,0)
  13454    .. I '$D( @RCGLB(344 .6)@("DILI ST",1,0))  D  Q
  13455   "RTN","RCD PESP1",118 ,0)
  13456    ... S X="        No  additional  payers ex cluded fro m Medical  Auto-Decre ase." D AD 2RPT($J("  ",80-$L(X) \2)_X)
  13457   "RTN","RCD PESP1",119 ,0)
  13458    ..;
  13459   "RTN","RCD PESP1",120 ,0)
  13460    .. D AD2R PT("     A dditional  Excluded P ayer            Comme nt")
  13461   "RTN","RCD PESP1",121 ,0)
  13462    .. S RCNT R=0
  13463   "RTN","RCD PESP1",122 ,0)
  13464    .. F  S R CNTR=$O(@R CGLB(344.6 )@("DILIST ",RCNTR))  Q:'RCNTR   D
  13465   "RTN","RCD PESP1",123 ,0)
  13466    ... S V=@ RCGLB(344. 6)@("DILIS T",RCNTR,0 ),X=$E($P( V,U,2),1,3 5)
  13467   "RTN","RCD PESP1",124 ,0)
  13468    ... S Y="      "_X_$ J(" ",36-$ L(X))_$P(V ,U,5)
  13469   "RTN","RCD PESP1",125 ,0)
  13470    ... D AD2 RPT($E(Y,1 ,IOM))
  13471   "RTN","RCD PESP1",126 ,0)
  13472    .;
  13473   "RTN","RCD PESP1",127 ,0)
  13474    .D AD2RPT (" ")
  13475   "RTN","RCD PESP1",128 ,0)
  13476    ;
  13477   "RTN","RCD PESP1",129 ,0)
  13478    K @RCGLB( 344.6)  ;  delete old  data
  13479   "RTN","RCD PESP1",130 ,0)
  13480    ; RCDPE A UTO-PAY EX CLUSION fi le (#344.6 )
  13481   "RTN","RCD PESP1",131 ,0)
  13482    ;   scree ning logic : ^DD(344. 6,.06,0)=" EXCLUDE ME D CLAIMS P OSTING^S^0 :No;1:Yes; ^0;6^Q"
  13483   "RTN","RCD PESP1",132 ,0)
  13484    D LIST^DI C(344.6,," @;.01;.02; .08;3","P" ,,,,,"I $P (^(0),U,8) =1",,RCGLB (344.6))
  13485   "RTN","RCD PESP1",133 ,0)
  13486    ;
  13487   "RTN","RCD PESP1",134 ,0)
  13488    ; PRCA*4. 5*304 - Pr int Pharma cy Claim P arameters
  13489   "RTN","RCD PESP1",135 ,0)
  13490    I RCTYPE' ="M" D
  13491   "RTN","RCD PESP1",136 ,0)
  13492    .; RCDPE  PARAMETER  file (#344 .61), auto -posting o f pharmacy  claims
  13493   "RTN","RCD PESP1",137 ,0)
  13494    .S X=$$GE T1^DID(344 .61,1.01,, "TITLE"),V =" (Y/N)"  S:X[V X=$P (X,V)_$P(X ,V,2)  ; r emove yes/ no prompt
  13495   "RTN","RCD PESP1",138 ,0)
  13496    .S Y=X_"  "_@RCGLB(3 44.61)@(34 4.61,"1,", 1.01,"E")
  13497   "RTN","RCD PESP1",139 ,0)
  13498    .D AD2RPT (Y)
  13499   "RTN","RCD PESP1",140 ,0)
  13500    .;
  13501   "RTN","RCD PESP1",141 ,0)
  13502    . I RCPAR M("RX AUTO -POST") D   ; list au to-post ex cluded pay ers
  13503   "RTN","RCD PESP1",142 ,0)
  13504    .. I '$D( @RCGLB(344 .6)@("DILI ST",1,0))  D  Q
  13505   "RTN","RCD PESP1",143 ,0)
  13506    ... S X="      No pa yers exclu ded from p harmacy au to-posting ." D AD2RP T($J(" ",8 0-$L(X)\2) _X)
  13507   "RTN","RCD PESP1",144 ,0)
  13508    ..;
  13509   "RTN","RCD PESP1",145 ,0)
  13510    .. D AD2R PT("   Exc luded Paye r                        Comment ")
  13511   "RTN","RCD PESP1",146 ,0)
  13512    .. S RCNT R=0
  13513   "RTN","RCD PESP1",147 ,0)
  13514    .. F  S R CNTR=$O(@R CGLB(344.6 )@("DILIST ",RCNTR))  Q:'RCNTR   D
  13515   "RTN","RCD PESP1",148 ,0)
  13516    ... S V=@ RCGLB(344. 6)@("DILIS T",RCNTR,0 ),X=$E($P( V,U,2),1,3 5)
  13517   "RTN","RCD PESP1",149 ,0)
  13518    ... S Y="    "_X_$J( " ",36-$L( X))_$P(V,U ,5)
  13519   "RTN","RCD PESP1",150 ,0)
  13520    ... D AD2 RPT($E(Y,1 ,IOM))
  13521   "RTN","RCD PESP1",151 ,0)
  13522    .. S X=$P ($$GET1^DI D(344.61,1 .02,,"TITL E")," (",1 )_": "  ;  remove yes /no prompt
  13523   "RTN","RCD PESP1",152 ,0)
  13524    .. S Y="      "_X_"  "_$S(@RCGL B(344.61)@ (344.61,"1 ,",1.02,"E ")="":"No" ,1:@RCGLB( 344.61)@(3 44.61,"1," ,1.02,"E") )
  13525   "RTN","RCD PESP1",153 ,0)
  13526    .. D AD2R PT(" "),AD 2RPT(Y)
  13527   "RTN","RCD PESP1",154 ,0)
  13528    .;
  13529   "RTN","RCD PESP1",155 ,0)
  13530    .I RCPARM ("RX AUTO- POST") D A D2RPT(" ")
  13531   "RTN","RCD PESP1",156 ,0)
  13532    .;
  13533   "RTN","RCD PESP1",157 ,0)
  13534    .K @RCGLB (344.6)  ;  delete ol d data
  13535   "RTN","RCD PESP1",158 ,0)
  13536    .;
  13537   "RTN","RCD PESP1",159 ,0)
  13538    .; PRCA*4 .5*304 - P rint the C ARC Auto-d ecrease pa rameters
  13539   "RTN","RCD PESP1",160 ,0)
  13540    . I $$CAR CCHK(RCTYP E,"P") D
  13541   "RTN","RCD PESP1",161 ,0)
  13542    .. S RCST RING=$TR($ J("",73),"  ","-"),RC I=0
  13543   "RTN","RCD PESP1",162 ,0)
  13544    .. D AD2R PT("  CARC   Descript ion                                                 Ma x. Amt")
  13545   "RTN","RCD PESP1",163 ,0)
  13546    .. D AD2R PT(RCSTRIN G)
  13547   "RTN","RCD PESP1",164 ,0)
  13548    .. ;
  13549   "RTN","RCD PESP1",165 ,0)
  13550    .. ; Loop  and print  entries
  13551   "RTN","RCD PESP1",166 ,0)
  13552    .. F  S R CI=$O(^RCY (344.62,RC I)) Q:'RCI   D
  13553   "RTN","RCD PESP1",167 ,0)
  13554    ...   S R CDATA=$G(^ RCY(344.62 ,RCI,0)),Y =""
  13555   "RTN","RCD PESP1",168 ,0)
  13556    ...   Q:R CDATA=""
  13557   "RTN","RCD PESP1",169 ,0)
  13558    ...   S R CCODE=$P(R CDATA,U),R CCIEN=$O(^ RC(345,"B" ,RCCODE,"" ))
  13559   "RTN","RCD PESP1",170 ,0)
  13560    ...   S R CDESC=$G(^ RC(345,RCC IEN,1,1,0) )
  13561   "RTN","RCD PESP1",171 ,0)
  13562    ...   S R CSTAT=$P(R CDATA,U,2)
  13563   "RTN","RCD PESP1",172 ,0)
  13564    ...   Q:R CSTAT'=1
  13565   "RTN","RCD PESP1",173 ,0)
  13566    ...   I $ L(RCDESC)> 50 S RCDES C=$E(RCDES C,1,50)_"  ..."
  13567   "RTN","RCD PESP1",174 ,0)
  13568    ...   D G ETCODES^RC DPCRR(RCCO DE,"","A", $$DT^XLFDT ,"RCCARCD" ,"1^70")
  13569   "RTN","RCD PESP1",175 ,0)
  13570    ...   S Y ="  "_$E(R CCODE,1,4) _"  "
  13571   "RTN","RCD PESP1",176 ,0)
  13572    ...   S Y =Y_$E(RCDE SC,1,55)_$ J($P(RCDAT A,U,6),10, 0)
  13573   "RTN","RCD PESP1",177 ,0)
  13574    ...   I ' $$ACT^RCDP RU(345,RCC ODE,) S Y= Y_" (I)"   ; if inact ive, displ ay (i)
  13575   "RTN","RCD PESP1",178 ,0)
  13576    ...   D A D2RPT(Y)
  13577   "RTN","RCD PESP1",179 ,0)
  13578    ;
  13579   "RTN","RCD PESP1",180 ,0)
  13580    ; RCDPE P ARAMETER f ile (#344. 61)
  13581   "RTN","RCD PESP1",181 ,0)
  13582    ;  ^DD(34 4.61,.06,0 ) > "MEDIC AL EFT POS T PREVENT  DAYS"
  13583   "RTN","RCD PESP1",182 ,0)
  13584    ;  ^DD(34 4.61,.07,0 ) > "PHARM ACY EFT PO ST PREVENT  DAYS"
  13585   "RTN","RCD PESP1",183 ,0)
  13586    ;  ^DD(34 4.61,.13,0 ) > "TRICA RE EFT POS T PREVENT  DAYS"
  13587   "RTN","RCD PESP1",184 ,0)
  13588    F RCFLD=. 06,.07,.13  D
  13589   "RTN","RCD PESP1",185 ,0)
  13590    . Q:(RCFL D=.06)&(RC TYPE="P")   ; Don't d isplay if  only showi ng Pharmac y paramete rs
  13591   "RTN","RCD PESP1",186 ,0)
  13592    . Q:(RCFL D=.07)&(RC TYPE="M")   ; Don't d isplay if  only showi ng medical  parameter s
  13593   "RTN","RCD PESP1",187 ,0)
  13594    . S Y=$$G ET1^DID(34 4.61,RCFLD ,,"TITLE") _" "_@RCGL B(344.61)@ (344.61,"1 ,",RCFLD," E")
  13595   "RTN","RCD PESP1",188 ,0)
  13596    . D AD2RP T(Y)
  13597   "RTN","RCD PESP1",189 ,0)
  13598    ;
  13599   "RTN","RCD PESP1",190 ,0)
  13600    D AD2RPT( " "),AD2RP T($$ENDORP RT^RCDPEAR L)
  13601   "RTN","RCD PESP1",191 ,0)
  13602    ;
  13603   "RTN","RCD PESP1",192 ,0)
  13604    S RCSTOP= 0 U IO D S PHDR(.RCHD R)
  13605   "RTN","RCD PESP1",193 ,0)
  13606    S J=0 F   S J=$O(^TM P($J,"RC S P REPORT", J)) Q:'J!R CSTOP  S Y =^TMP($J," RC SP REPO RT",J,0) D
  13607   "RTN","RCD PESP1",194 ,0)
  13608    .W !,Y Q: '$O(^TMP($ J,"RC SP R EPORT",J))   ; quit i f last lin e
  13609   "RTN","RCD PESP1",195 ,0)
  13610    .I '$G(ZT SK),$E(IOS T,1,2)="C- ",$Y+3>IOS L D ASK^RC DPEARL(.RC STOP) I 'R CSTOP D SP HDR(.RCHDR ) Q
  13611   "RTN","RCD PESP1",196 ,0)
  13612    .Q:RCSTOP   Q:$Y+2<I OSL
  13613   "RTN","RCD PESP1",197 ,0)
  13614    .D SPHDR( .RCHDR)
  13615   "RTN","RCD PESP1",198 ,0)
  13616    ;
  13617   "RTN","RCD PESP1",199 ,0)
  13618    I '$G(ZTS K),$E(IOST ,1,2)="C-" ,'RCSTOP D  ASK^RCDPE ARL(.RCSTO P)
  13619   "RTN","RCD PESP1",200 ,0)
  13620    ;
  13621   "RTN","RCD PESP1",201 ,0)
  13622    ; close d evice
  13623   "RTN","RCD PESP1",202 ,0)
  13624    U IO(0) D  ^%ZISC
  13625   "RTN","RCD PESP1",203 ,0)
  13626    ;
  13627   "RTN","RCD PESP1",204 ,0)
  13628    S X="RC"  F  S X=$O( ^TMP($J,X) ) Q:'($E(X ,1,2)="RC" )  K ^TMP( $J,X) ; cl ean up
  13629   "RTN","RCD PESP1",205 ,0)
  13630    ;
  13631   "RTN","RCD PESP1",206 ,0)
  13632    Q
  13633   "RTN","RCD PESP1",207 ,0)
  13634    ;
  13635   "RTN","RCD PESP1",208 ,0)
  13636   SPHDR(HDR)  ; HDR pas sed by ref .
  13637   "RTN","RCD PESP1",209 ,0)
  13638    ; HDR("RU NDATE") -  run date,  external f ormat
  13639   "RTN","RCD PESP1",210 ,0)
  13640    ;  HDR("P GNMBR") -  page numbe r
  13641   "RTN","RCD PESP1",211 ,0)
  13642    ;    HDR( "SITE") -  site name
  13643   "RTN","RCD PESP1",212 ,0)
  13644    N P,X,Y
  13645   "RTN","RCD PESP1",213 ,0)
  13646    S P=$G(HD R("PGNMBR" ))+1,HDR(" PGNMBR")=P   ; increm ent page c ount
  13647   "RTN","RCD PESP1",214 ,0)
  13648    ; 
  13649   "RTN","RCD PESP1",215 ,0)
  13650    S X=$$HDR LN
  13651   "RTN","RCD PESP1",216 ,0)
  13652    S P=IOM-( $L(X)+10)\ 2,Y=$J(" " ,P)_X_$J("  ",P)_" Pa ge: "_HDR( "PGNMBR")
  13653   "RTN","RCD PESP1",217 ,0)
  13654    W @IOF,Y
  13655   "RTN","RCD PESP1",218 ,0)
  13656    S X="   R un Date: " _HDR("RUND ATE"),Y=X_ $J(HDR("SI TE"),IOM-( $L(X)+1))
  13657   "RTN","RCD PESP1",219 ,0)
  13658    W !,Y
  13659   "RTN","RCD PESP1",220 ,0)
  13660    S Y=" "_$ TR($J("",I OM-2)," ", "-")  ; sp ace_row of  hyphens
  13661   "RTN","RCD PESP1",221 ,0)
  13662    W !,Y
  13663   "RTN","RCD PESP1",222 ,0)
  13664    Q
  13665   "RTN","RCD PESP1",223 ,0)
  13666    ;
  13667   "RTN","RCD PESP1",224 ,0)
  13668   AD2RPT(A)  ; add line  to report
  13669   "RTN","RCD PESP1",225 ,0)
  13670    Q:$G(A)=" "
  13671   "RTN","RCD PESP1",226 ,0)
  13672    N C S C=$ G(^TMP($J, "RC SP REP ORT",0))+1 ,^TMP($J," RC SP REPO RT",0)=C
  13673   "RTN","RCD PESP1",227 ,0)
  13674    S ^TMP($J ,"RC SP RE PORT",C,0) =A Q
  13675   "RTN","RCD PESP1",228 ,0)
  13676    ;
  13677   "RTN","RCD PESP1",229 ,0)
  13678   HDRLN() Q  "EDI Lockb ox Paramet ers Report "_$S($G(RC TYPE)="B": " - ALL",$ G(RCTYPE)= "M":" - ME DICAL",$G( RCTYPE)="P ":" - PHAR MACY",1:"" )  ; extri nsic varia ble
  13679   "RTN","RCD PESP1",230 ,0)
  13680    ;
  13681   "RTN","RCD PESP1",231 ,0)
  13682    ;Function  to check  to see if  the CARC p arameters  are to app ear on the  report
  13683   "RTN","RCD PESP1",232 ,0)
  13684   CARCCHK(RC TYPE,TYPE)  ;
  13685   "RTN","RCD PESP1",233 ,0)
  13686    ;
  13687   "RTN","RCD PESP1",234 ,0)
  13688    N RCMEN,R CREN
  13689   "RTN","RCD PESP1",235 ,0)
  13690    ;
  13691   "RTN","RCD PESP1",236 ,0)
  13692    ; Return  1 if valid  to print,  0 otherwi se
  13693   "RTN","RCD PESP1",237 ,0)
  13694    ;
  13695   "RTN","RCD PESP1",238 ,0)
  13696    Q:RCTYPE= "B"&($G(TY PE)="M") + $P($G(^RCY (344.61,1, 0)),U,3)   ;User want s all para meters and  we are ch ecking for  medical a uto decrea se
  13697   "RTN","RCD PESP1",239 ,0)
  13698    ;
  13699   "RTN","RCD PESP1",240 ,0)
  13700    Q:RCTYPE= "B"&($G(TY PE)="P") + $P($G(^RCY (344.61,1, 1)),U,2)   ;User want s all para meters and  we are ch ecking for  Pharmacy  auto decre ase
  13701   "RTN","RCD PESP1",241 ,0)
  13702    ;
  13703   "RTN","RCD PESP1",242 ,0)
  13704    S (RCMEN, RCREN)=""
  13705   "RTN","RCD PESP1",243 ,0)
  13706    ;
  13707   "RTN","RCD PESP1",244 ,0)
  13708    ;Print if  Report ty pe is medi cal and au to-decreas e for medi cal is on
  13709   "RTN","RCD PESP1",245 ,0)
  13710    I RCTYPE= "M" S RCME N=+$P($G(^ RCY(344.61 ,1,0)),U,3 ) Q RCMEN
  13711   "RTN","RCD PESP1",246 ,0)
  13712    ;
  13713   "RTN","RCD PESP1",247 ,0)
  13714    ;Print if  Report ty pe is phar macy and a uto-decrea se for pha rmacy is o n
  13715   "RTN","RCD PESP1",248 ,0)
  13716    I RCTYPE= "P" S RCRE N=+$P($G(^ RCY(344.61 ,1,1)),U,2 ) Q RCREN
  13717   "RTN","RCD PESP1",249 ,0)
  13718    ;
  13719   "RTN","RCD PESP1",250 ,0)
  13720    Q 0  ;Don 't print t he CARCs
  13721   "RTN","RCD PESP1",251 ,0)
  13722    ;
  13723   "RTN","RCD PESP1",252 ,0)
  13724    ; BEGIN -  PRCA*4.5* 326
  13725   "RTN","RCD PESP1",253 ,0)
  13726   AUTOD(PAID ,RCGBL,RCT YPE) ; Dis play auto- decrease p arameters
  13727   "RTN","RCD PESP1",254 ,0)
  13728    ; INPUT    PAID - 1  = paid lin e paramete rs 0 = no- payment li ne paramet ers
  13729   "RTN","RCD PESP1",255 ,0)
  13730    ;          RCGBL - f ield value  array fro m LIST^DIC  call
  13731   "RTN","RCD PESP1",256 ,0)
  13732    ;          RCTYPE -  report typ e (P)harma cy, (M)edi cal
  13733   "RTN","RCD PESP1",257 ,0)
  13734    ; OUTPUT    Lists pa rameters
  13735   "RTN","RCD PESP1",258 ,0)
  13736    ;
  13737   "RTN","RCD PESP1",259 ,0)
  13738    N CNT,FIE LD,X,Y
  13739   "RTN","RCD PESP1",260 ,0)
  13740    ; RCDPE P ARAMETER f ile (#344. 61), auto- decrease o f medical  claims 
  13741   "RTN","RCD PESP1",261 ,0)
  13742    S FIELD=$ S(PAID:.03 ,1:.11)
  13743   "RTN","RCD PESP1",262 ,0)
  13744    S X=$$GET 1^DID(344. 61,FIELD,, "TITLE")
  13745   "RTN","RCD PESP1",263 ,0)
  13746    S X=$P(X, " (Y/N): " ) ; remove  yes/no pr ompt
  13747   "RTN","RCD PESP1",264 ,0)
  13748    S Y=$J(X, 45)_@RCGLB (344.61)@( 344.61,"1, ",FIELD,"E ")
  13749   "RTN","RCD PESP1",265 ,0)
  13750    D AD2RPT( " "),AD2RP T(Y)
  13751   "RTN","RCD PESP1",266 ,0)
  13752    ; If auto -decrease  is off - d o not disp lay CARCS  or auto-de crease day s or auto- decrease m aximum
  13753   "RTN","RCD PESP1",267 ,0)
  13754    I +$$GET1 ^DIQ(344.6 1,"1,",FIE LD,"I")=0  Q
  13755   "RTN","RCD PESP1",268 ,0)
  13756    ;
  13757   "RTN","RCD PESP1",269 ,0)
  13758    I PAID D  AD2RPT("MA XIMUM DOLL AR AMOUNT  TO AUTO-DE CREASE PER  CLAIM: "_ "$"_(+$P(R CPARM(344. 61,0),U,5) ))
  13759   "RTN","RCD PESP1",270 ,0)
  13760    ;
  13761   "RTN","RCD PESP1",271 ,0)
  13762    S CNT=0
  13763   "RTN","RCD PESP1",272 ,0)
  13764    ; Print t he CARC Au to-decreas e paramete rs
  13765   "RTN","RCD PESP1",273 ,0)
  13766    I $$CARCC HK(RCTYPE, "M") D
  13767   "RTN","RCD PESP1",274 ,0)
  13768    . D AD2RP T(" ")
  13769   "RTN","RCD PESP1",275 ,0)
  13770    . D AD2RP T(" AUTO-D ECREASE "_ $S(PAID:"" ,1:"NO-PAY  ")_"MEDIC AL CLAIMS  FOR THE FO LLOWING CA RC/AMOUNTS  ONLY:")
  13771   "RTN","RCD PESP1",276 ,0)
  13772    . D AD2RP T(" ")
  13773   "RTN","RCD PESP1",277 ,0)
  13774    . S RCSTR ING=$TR($J ("",70),"  ","-"),RCI =0
  13775   "RTN","RCD PESP1",278 ,0)
  13776    . D AD2RP T(" CARC D escription                                                 Max. A mt")
  13777   "RTN","RCD PESP1",279 ,0)
  13778    . D AD2RP T(" "_RCST RING)
  13779   "RTN","RCD PESP1",280 ,0)
  13780    . ;
  13781   "RTN","RCD PESP1",281 ,0)
  13782    . ; Loop  and print  entries
  13783   "RTN","RCD PESP1",282 ,0)
  13784    . F  S RC I=$O(^RCY( 344.62,RCI )) Q:'RCI   D
  13785   "RTN","RCD PESP1",283 ,0)
  13786    . . S Y=" "
  13787   "RTN","RCD PESP1",284 ,0)
  13788    . . S RCC ODE=$$GET1 ^DIQ(344.6 2,RCI_",", .01)
  13789   "RTN","RCD PESP1",285 ,0)
  13790    . . Q:'RC CODE
  13791   "RTN","RCD PESP1",286 ,0)
  13792    . . S RCC IEN=$O(^RC (345,"B",R CCODE,""))
  13793   "RTN","RCD PESP1",287 ,0)
  13794    . . S RCD ESC=$G(^RC (345,RCCIE N,1,1,0))  ; WP field  345.04
  13795   "RTN","RCD PESP1",288 ,0)
  13796    . . S FIE LD=$S(PAID :.02,1:.08 )
  13797   "RTN","RCD PESP1",289 ,0)
  13798    . . S RCS TAT=$$GET1 ^DIQ(344.6 2,RCI,FIEL D,"I")
  13799   "RTN","RCD PESP1",290 ,0)
  13800    . . Q:RCS TAT'=1
  13801   "RTN","RCD PESP1",291 ,0)
  13802    . . S CNT =CNT+1
  13803   "RTN","RCD PESP1",292 ,0)
  13804    . . I $L( RCDESC)>50  S RCDESC= $E(RCDESC, 1,50)_" .. ."
  13805   "RTN","RCD PESP1",293 ,0)
  13806    . . D GET CODES^RCDP CRR(RCCODE ,"","A",$$ DT^XLFDT," RCCARCD"," 1^70")
  13807   "RTN","RCD PESP1",294 ,0)
  13808    . . S Y="  "_$J(RCCO DE,4)_" "
  13809   "RTN","RCD PESP1",295 ,0)
  13810    . . S Y=Y _$E(RCDESC ,1,53)
  13811   "RTN","RCD PESP1",296 ,0)
  13812    . . S:$L( RCDESC)<53  Y=Y_$J("" ,(53-$L(RC DESC)))
  13813   "RTN","RCD PESP1",297 ,0)
  13814    . . S FIE LD=$S(PAID :.06,1:.12 )
  13815   "RTN","RCD PESP1",298 ,0)
  13816    . . S Y=Y _$J($$GET1 ^DIQ(344.6 2,RCI,FIEL D,"I"),10, 0)
  13817   "RTN","RCD PESP1",299 ,0)
  13818    . . I '$$ ACT^RCDPRU (345,RCCOD E,) S Y=Y_ " (I)"  ;  if inactiv e, display  (i)
  13819   "RTN","RCD PESP1",300 ,0)
  13820    . . D AD2 RPT(Y)
  13821   "RTN","RCD PESP1",301 ,0)
  13822    . I CNT=0  D AD2RPT( " No CARCs  are set u p for "_$S (PAID:"",1 :"NO-PAY " )_"auto-de crease")
  13823   "RTN","RCD PESP1",302 ,0)
  13824    ;
  13825   "RTN","RCD PESP1",303 ,0)
  13826    ; Display  auto-decr ease days
  13827   "RTN","RCD PESP1",304 ,0)
  13828    S FIELD=$ S(PAID:.04 ,1:.12)
  13829   "RTN","RCD PESP1",305 ,0)
  13830    S X=$P($$ GET1^DID(3 44.61,FIEL D,,"TITLE" )," (",1)_ ": "
  13831   "RTN","RCD PESP1",306 ,0)
  13832    S Y=$J(X, 40)_@RCGLB (344.61)@( 344.61,"1, ",FIELD,"E ")
  13833   "RTN","RCD PESP1",307 ,0)
  13834    D AD2RPT( " "),AD2RP T(Y)
  13835   "RTN","RCD PESP1",308 ,0)
  13836    Q
  13837   "RTN","RCD PESP1",309 ,0)
  13838    ; END - P RCA*4.5*32 6
  13839   "RTN","RCD PESP2")
  13840   0^26^B1010 41466
  13841   "RTN","RCD PESP2",1,0 )
  13842   RCDPESP2 ; BIRM/SAB -  ePayment  Lockbox Pa rameter Au dit and Ex clusion Re ports ;17  Oct 2018 1 8:52:41
  13843   "RTN","RCD PESP2",2,0 )
  13844    ;;4.5;Acc ounts Rece ivable;**2 98,304,317 ,321,326,3 32**;Mar 2 0, 1995;Bu ild 34
  13845   "RTN","RCD PESP2",3,0 )
  13846    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  13847   "RTN","RCD PESP2",4,0 )
  13848    ;
  13849   "RTN","RCD PESP2",5,0 )
  13850    Q
  13851   "RTN","RCD PESP2",6,0 )
  13852    ;
  13853   "RTN","RCD PESP2",7,0 )
  13854   RPT1 ; EDI  Lockbox P arameters  Report [RC DPE SITE P ARAMETER R EPORT]
  13855   "RTN","RCD PESP2",8,0 )
  13856    G AUDPARM ^RCDPESPA   ; PRCA*4. 5*332, rep ort moved,  11 Octobe r 2018
  13857   "RTN","RCD PESP2",9,0 )
  13858    Q
  13859   "RTN","RCD PESP2",10, 0)
  13860    ;
  13861   "RTN","RCD PESP2",11, 0)
  13862   HDRLPR(RCE XCEL,RCHDR ,RCSTOP) ;  Report he ader Lockb ox Paramet er Report
  13863   "RTN","RCD PESP2",12, 0)
  13864    ;   RCEXC EL - if tr ue output  for Excel
  13865   "RTN","RCD PESP2",13, 0)
  13866    ;   RCHDR ("PAGE") -  page coun t, passed  by ref.
  13867   "RTN","RCD PESP2",14, 0)
  13868    ;   RCSTO P  - repor t exit fla g
  13869   "RTN","RCD PESP2",15, 0)
  13870    ;   RCTYP E  - Type  of report  to run
  13871   "RTN","RCD PESP2",16, 0)
  13872    ;
  13873   "RTN","RCD PESP2",17, 0)
  13874    N RCTYPED
  13875   "RTN","RCD PESP2",18, 0)
  13876    S RCTYPED =$S(RCHDR( "REPORTTYP E")="M":"M EDICAL",RC HDR("REPOR TTYPE")="P ":"PHARMAC Y",1:"ALL" )
  13877   "RTN","RCD PESP2",19, 0)
  13878    ;
  13879   "RTN","RCD PESP2",20, 0)
  13880    I RCEXCEL  D  Q  ; E xcel heade r for PARA METER AUDI TS
  13881   "RTN","RCD PESP2",21, 0)
  13882    .Q:RCHDR( "PAGE")
  13883   "RTN","RCD PESP2",22, 0)
  13884    .W !,"PAR AMETER^DAT E/TIME EDI TED^OLD VA LUE^NEW VA LUE^USER"
  13885   "RTN","RCD PESP2",23, 0)
  13886    .S RCHDR( "PAGE")=1   ; only pr int once
  13887   "RTN","RCD PESP2",24, 0)
  13888    ;
  13889   "RTN","RCD PESP2",25, 0)
  13890    I 'RCEXCE L D
  13891   "RTN","RCD PESP2",26, 0)
  13892    .I RCHDR( "PAGE") D  ASK^RCDPEA RL(.RCSTOP ) Q:RCSTOP
  13893   "RTN","RCD PESP2",27, 0)
  13894    .W @IOF
  13895   "RTN","RCD PESP2",28, 0)
  13896    .S RCHDR( "PAGE")=RC HDR("PAGE" )+1
  13897   "RTN","RCD PESP2",29, 0)
  13898    . W $$CNT R("EDI Loc kbox Param eter Audit  Report"), ?IOM-8,"Pa ge: "_RCHD R("PAGE")
  13899   "RTN","RCD PESP2",30, 0)
  13900    . W !,$$C NTR("RUN D ATE: "_RCH DR("RUNDAT E"))
  13901   "RTN","RCD PESP2",31, 0)
  13902    . W !,$$C NTR("DATE  RANGE: "_R CHDR("DATE RANGE"))
  13903   "RTN","RCD PESP2",32, 0)
  13904    . W !,$$C NTR("REPOR T TYPE: "_ RCTYPED)
  13905   "RTN","RCD PESP2",33, 0)
  13906    . W !!,"L OCKBOX PAR AMETER UPD ATES"
  13907   "RTN","RCD PESP2",34, 0)
  13908    . W !,"-- ---------- ---------- ---                              Values"
  13909   "RTN","RCD PESP2",35, 0)
  13910    . W !,"Pa rameter                          Date/Time  Edited   O ld  New  U ser"
  13911   "RTN","RCD PESP2",36, 0)
  13912    . N I S $ P(I,"=",IO M+1)="" W  !,I
  13913   "RTN","RCD PESP2",37, 0)
  13914    Q
  13915   "RTN","RCD PESP2",38, 0)
  13916    ;
  13917   "RTN","RCD PESP2",39, 0)
  13918   RPT2 ; EDI  Lockbox E xclusion A udit Repor t [RCDPE E XCLUSION A UDIT REPOR T]
  13919   "RTN","RCD PESP2",40, 0)
  13920    ;
  13921   "RTN","RCD PESP2",41, 0)
  13922    ; DESCRIP TION: This  report is  a simple  listing of  the RCDPE  PARAMETER  AUDIT fil e
  13923   "RTN","RCD PESP2",42, 0)
  13924    ;               incl uding data  concernin g changes  to the RCD PE AUTO-PA Y EXCLUSIO N file.
  13925   "RTN","RCD PESP2",43, 0)
  13926    ;
  13927   "RTN","RCD PESP2",44, 0)
  13928    ; GLOBALS :     ^RCY (344.7,                RCDPE PAR AMETER AUD IT
  13929   "RTN","RCD PESP2",45, 0)
  13930    ;               ^RCY (344.6,                RCDPE AUT O-PAY EXCL USION
  13931   "RTN","RCD PESP2",46, 0)
  13932    ;               ^TMP ("RCDPESP2 ",$J,       TMP FILE  FOR LIST D IC OUTPUT
  13933   "RTN","RCD PESP2",47, 0)
  13934    ;
  13935   "RTN","RCD PESP2",48, 0)
  13936    ; INPUT P ARAMETERS:  NONE
  13937   "RTN","RCD PESP2",49, 0)
  13938    ;
  13939   "RTN","RCD PESP2",50, 0)
  13940    ; LOCAL V ARIABLES:
  13941   "RTN","RCD PESP2",51, 0)
  13942    ;    RCRA NGE - date  range for  report
  13943   "RTN","RCD PESP2",52, 0)
  13944    ;    RCST DT  - repo rt start d ate
  13945   "RTN","RCD PESP2",53, 0)
  13946    ;    RCEN DT  - repo rt end dat e
  13947   "RTN","RCD PESP2",54, 0)
  13948    ;    RCEX CEL - true  if report  in Excel  format
  13949   "RTN","RCD PESP2",55, 0)
  13950    ;    RCSC R - screen ing logic  for LIST^D IC
  13951   "RTN","RCD PESP2",56, 0)
  13952    ;    RCFL DS  - fiel ds for LIS T^DIC
  13953   "RTN","RCD PESP2",57, 0)
  13954    ;    RCDI GET - stor age for re sults from  LIST^DIC
  13955   "RTN","RCD PESP2",58, 0)
  13956    ;    RCDI ERR - erro rs from LI ST^DIC
  13957   "RTN","RCD PESP2",59, 0)
  13958    ;    RCHD R("PAGE")   - page co unter
  13959   "RTN","RCD PESP2",60, 0)
  13960    ;    RCHD R("RUNDATE ") - date/ time repor t was run 
  13961   "RTN","RCD PESP2",61, 0)
  13962    ;    RCST OP  - repo rt exit fl ag
  13963   "RTN","RCD PESP2",62, 0)
  13964    ;    RCPA RAM - para meter that  was chang ed
  13965   "RTN","RCD PESP2",63, 0)
  13966    ;    RCPA RAM("TIME" )   - time  parameter  changed
  13967   "RTN","RCD PESP2",64, 0)
  13968    ;    RCPA RAM("OLDVA L") - old  parameter  value
  13969   "RTN","RCD PESP2",65, 0)
  13970    ;    RCPA RAM("NEWVA L") - new  parameter  value
  13971   "RTN","RCD PESP2",66, 0)
  13972    ;    RCPA RAM("USER" )  - USER  WHO CHANGE D A PARAME TER
  13973   "RTN","RCD PESP2",67, 0)
  13974    ;    RCTM P - one re cord from  LIST^DIC
  13975   "RTN","RCD PESP2",68, 0)
  13976    ;    RCFN D - flag i ndicating  records re turned
  13977   "RTN","RCD PESP2",69, 0)
  13978    ;    RCTY PE  - TYPE  OF REPORT  TO RUN (M EDICAL, PH ARMACY, OR  BOTH)
  13979   "RTN","RCD PESP2",70, 0)
  13980    ;
  13981   "RTN","RCD PESP2",71, 0)
  13982    W !!,"    EDI Lockbo x Exclusio n Audit Re port",!
  13983   "RTN","RCD PESP2",72, 0)
  13984    ;
  13985   "RTN","RCD PESP2",73, 0)
  13986    N RCENDT, RCEXCEL,RC FLDS,RCFND ,RCDIGET,R CHDR,RCIEN ,RCDIERR,R CPARAM,RCR ANGE,RCSCR ,RCSTDT,RC STOP,RCTMP ,RCTYPE,RC SCRTYP,RCD IMED,RCDIR X
  13987   "RTN","RCD PESP2",74, 0)
  13988    ; Kernel  variables
  13989   "RTN","RCD PESP2",75, 0)
  13990    N X1,X2,X ,Y,%ZIS,PO P
  13991   "RTN","RCD PESP2",76, 0)
  13992    ; initial ize values
  13993   "RTN","RCD PESP2",77, 0)
  13994    S (RCHDR( "PAGE"),RC STOP,RCIEN ,RCEXCEL,R CFND)=0
  13995   "RTN","RCD PESP2",78, 0)
  13996    S RCDIGET =$NA(^TMP( "RCDPESP2" ,$J)) K @R CDIGET
  13997   "RTN","RCD PESP2",79, 0)
  13998    ; PRCA*4. 5*304 - Me dical and  RX audit e ntries
  13999   "RTN","RCD PESP2",80, 0)
  14000    S RCDIMED =$NA(^TMP( "RCDPESP2- MED",$J))  K @RCDIMED
  14001   "RTN","RCD PESP2",81, 0)
  14002    S RCDIRX= $NA(^TMP(" RCDPESP2-R X",$J)) K  @RCDIRX
  14003   "RTN","RCD PESP2",82, 0)
  14004    ;
  14005   "RTN","RCD PESP2",83, 0)
  14006    S RCTYPE= $$RTYPE()
  14007   "RTN","RCD PESP2",84, 0)
  14008    Q:RCTYPE= -1
  14009   "RTN","RCD PESP2",85, 0)
  14010    S RCHDR(" REPORTTYPE ")=RCTYPE
  14011   "RTN","RCD PESP2",86, 0)
  14012    ;
  14013   "RTN","RCD PESP2",87, 0)
  14014    ; GET DAT E RANGES
  14015   "RTN","RCD PESP2",88, 0)
  14016    S RCRANGE =$$DTRNG()
  14017   "RTN","RCD PESP2",89, 0)
  14018    Q:RCRANGE =0
  14019   "RTN","RCD PESP2",90, 0)
  14020    S RCSTDT= $P(RCRANGE ,U,2)-.000 0001,RCEND T=$P(RCRAN GE,U,3)+.9 999999
  14021   "RTN","RCD PESP2",91, 0)
  14022    ;
  14023   "RTN","RCD PESP2",92, 0)
  14024    ; output  fields for  LIST^DIC
  14025   "RTN","RCD PESP2",93, 0)
  14026    S RCFLDS= "@;.04;.01 I;.06;.03; .08;.02"
  14027   "RTN","RCD PESP2",94, 0)
  14028    ; .04 - C HANGED FIE LD  .01 -  TIMESTAMP       .06 -  NEW VALUE
  14029   "RTN","RCD PESP2",95, 0)
  14030    ; .03 - C HANGED BY      .08 -  COMMENT         .02 -  MODIFIED  IEN
  14031   "RTN","RCD PESP2",96, 0)
  14032    ;
  14033   "RTN","RCD PESP2",97, 0)
  14034    ; first p art of LIS T^DIC scre ening logi c
  14035   "RTN","RCD PESP2",98, 0)
  14036    S RCSCR=" I ($P(^(0) ,U,5)=344. 6)&($P(^(0 ),U,1)>"_R CSTDT_")&( $P(^(0),U, 1)<"_RCEND T_")"
  14037   "RTN","RCD PESP2",99, 0)
  14038    ;
  14039   "RTN","RCD PESP2",100 ,0)
  14040    ; OUTPUT  TO EXCEL?
  14041   "RTN","RCD PESP2",101 ,0)
  14042    S RCEXCEL =$$DISPTY^ RCDPEM3()  Q:+RCEXCEL =-1
  14043   "RTN","RCD PESP2",102 ,0)
  14044    I RCEXCEL  D INFO^RC DPEM6
  14045   "RTN","RCD PESP2",103 ,0)
  14046    ;
  14047   "RTN","RCD PESP2",104 ,0)
  14048    ;Select o utput devi ce
  14049   "RTN","RCD PESP2",105 ,0)
  14050    S %ZIS="M " D ^%ZIS  Q:POP  U I O
  14051   "RTN","RCD PESP2",106 ,0)
  14052    ;
  14053   "RTN","RCD PESP2",107 ,0)
  14054    S RCHDR(" RUNDATE")= $$FMTE^XLF DT($$NOW^X LFDT,"5S")
  14055   "RTN","RCD PESP2",108 ,0)
  14056    ;
  14057   "RTN","RCD PESP2",109 ,0)
  14058    ; PROCESS  AUTO-POST  EXCLUSION S
  14059   "RTN","RCD PESP2",110 ,0)
  14060    ;
  14061   "RTN","RCD PESP2",111 ,0)
  14062    ; PRCA*4. 5*304 - Ge t the corr ect screen ing logic,  based on  the type o f audit re eport to r un
  14063   "RTN","RCD PESP2",112 ,0)
  14064    S RCSCR(. 06)=RCSCR_ "&($P(^(0) ,U,4)=.06) " ; screen ing logic  for medica l auto-pos t
  14065   "RTN","RCD PESP2",113 ,0)
  14066    S RCSCR(. 07)=RCSCR_ "&($P(^(0) ,U,4)=.07) " ; screen ing logic  for medica l auto-dec rease
  14067   "RTN","RCD PESP2",114 ,0)
  14068    S RCSCR(. 08)=RCSCR_ "&($P(^(0) ,U,4)=.08) " ; screen ing logic  for pharma cy auto-po st
  14069   "RTN","RCD PESP2",115 ,0)
  14070    ;
  14071   "RTN","RCD PESP2",116 ,0)
  14072    ;PRCA*4.5 *304 - Get  the medic al and RX  audit entr ies for Au to-Post ex clusions
  14073   "RTN","RCD PESP2",117 ,0)
  14074    D LIST^DI C(344.7,,R CFLDS,"P", ,,,,RCSCR( .06),,RCDI MED,"RCDIE RR")
  14075   "RTN","RCD PESP2",118 ,0)
  14076    ; CHECK F OR AN ERRO R
  14077   "RTN","RCD PESP2",119 ,0)
  14078    I $D(RCDI ERR) W !!, "Error col lecting au to-post re port data. " D ASK^RC DPEARL(.RC STOP) Q
  14079   "RTN","RCD PESP2",120 ,0)
  14080    ;
  14081   "RTN","RCD PESP2",121 ,0)
  14082    ; Get the  correct s creening l ogic, base d on the t ype of aud it to run
  14083   "RTN","RCD PESP2",122 ,0)
  14084    D LIST^DI C(344.7,,R CFLDS,"P", ,,,,RCSCR( .07),,RCDI GET,"RCDIE RR")
  14085   "RTN","RCD PESP2",123 ,0)
  14086    ;
  14087   "RTN","RCD PESP2",124 ,0)
  14088    ; CHECK F OR AN ERRO R
  14089   "RTN","RCD PESP2",125 ,0)
  14090    I $D(RCDI ERR) W !!, "Error col lecting au to-decreas e report d ata." D AS K^RCDPEARL (.RCSTOP)  Q
  14091   "RTN","RCD PESP2",126 ,0)
  14092    ;
  14093   "RTN","RCD PESP2",127 ,0)
  14094    D LIST^DI C(344.7,,R CFLDS,"P", ,,,,RCSCR( .08),,RCDI RX,"RCDIER R")
  14095   "RTN","RCD PESP2",128 ,0)
  14096    ; CHECK F OR AN ERRO R
  14097   "RTN","RCD PESP2",129 ,0)
  14098    I $D(RCDI ERR) W !!, "Error col lecting au to-post re port data. " D ASK^RC DPEARL(.RC STOP) Q
  14099   "RTN","RCD PESP2",130 ,0)
  14100    ;
  14101   "RTN","RCD PESP2",131 ,0)
  14102    I (RCTYPE ="B")!(RCT YPE="M") D   G:RCSTOP  RPT2Q
  14103   "RTN","RCD PESP2",132 ,0)
  14104    . D HDRXA R(.06,RCTY PE)  ; com plete head er
  14105   "RTN","RCD PESP2",133 ,0)
  14106    . ;
  14107   "RTN","RCD PESP2",134 ,0)
  14108    . S RCFND =$D(@RCDIM ED@("DILIS T",1))  ;  CHECK FOR  RECORDS RE TURNED
  14109   "RTN","RCD PESP2",135 ,0)
  14110    . I 'RCFN D W !,"No  Auto-post  Exclusions  to Displa y",!
  14111   "RTN","RCD PESP2",136 ,0)
  14112    . ;
  14113   "RTN","RCD PESP2",137 ,0)
  14114    . I RCFND  S RCIEN=0  D
  14115   "RTN","RCD PESP2",138 ,0)
  14116    .. F  S R CIEN=$O(@R CDIMED@("D ILIST",RCI EN)) Q:RCS TOP!('RCIE N)  D
  14117   "RTN","RCD PESP2",139 ,0)
  14118    ... S RCT MP=$P(@RCD IMED@("DIL IST",RCIEN ,0),U,2,7)
  14119   "RTN","RCD PESP2",140 ,0)
  14120    ... I 'RC EXCEL,$Y+4 >IOSL D HD RXAR(.06,R CTYPE) Q:R CSTOP
  14121   "RTN","RCD PESP2",141 ,0)
  14122    ... D DSP XCLSN(RCTM P)
  14123   "RTN","RCD PESP2",142 ,0)
  14124    . ; PROCE SS MEDICAL  AUTO-DECR EASE EXCLU SIONS
  14125   "RTN","RCD PESP2",143 ,0)
  14126    . D  ; co mplete hea der or jus t the sect ion
  14127   "RTN","RCD PESP2",144 ,0)
  14128    .. I $Y+1 1<IOSL D S ECTHDR(.07 )  Q  ; ju st section  header
  14129   "RTN","RCD PESP2",145 ,0)
  14130    .. D HDRX AR(.07,RCT YPE)  ; co mplete hea der
  14131   "RTN","RCD PESP2",146 ,0)
  14132    . ;
  14133   "RTN","RCD PESP2",147 ,0)
  14134    . S RCFND =$D(@RCDIG ET@("DILIS T",1))  ;  CHECK FOR  RECORDS RE TURNED
  14135   "RTN","RCD PESP2",148 ,0)
  14136    . I 'RCFN D W !,"No  Auto-decre ase Exclus ions to Di splay",!
  14137   "RTN","RCD PESP2",149 ,0)
  14138    . ; RECOR DS RETURNE D
  14139   "RTN","RCD PESP2",150 ,0)
  14140    . I RCFND  S RCIEN=0  F  S RCIE N=$O(@RCDI GET@("DILI ST",RCIEN) ) Q:RCSTOP !('RCIEN)   D
  14141   "RTN","RCD PESP2",151 ,0)
  14142    .. S RCTM P=$P(@RCDI GET@("DILI ST",RCIEN, 0),U,2,7)
  14143   "RTN","RCD PESP2",152 ,0)
  14144    .. I $Y+4 >IOSL D HD RXAR(.07,R CTYPE) Q:R CSTOP
  14145   "RTN","RCD PESP2",153 ,0)
  14146    .. D DSPX CLSN(RCTMP )
  14147   "RTN","RCD PESP2",154 ,0)
  14148    ;
  14149   "RTN","RCD PESP2",155 ,0)
  14150    I (RCTYPE ="B")!(RCT YPE="P") D   G:RCSTOP  RPT2Q
  14151   "RTN","RCD PESP2",156 ,0)
  14152    . I RCTYP E="P" D HD RXAR(.08,R CTYPE)  ;  complete h eader
  14153   "RTN","RCD PESP2",157 ,0)
  14154    . I RCTYP E'="P" D   ; complete  header or  just the  section
  14155   "RTN","RCD PESP2",158 ,0)
  14156    .. I $Y+1 1<IOSL D S ECTHDR(.08 )  Q  ; ju st section  header
  14157   "RTN","RCD PESP2",159 ,0)
  14158    .. D HDRX AR(.08,RCT YPE)  ; co mplete hea der
  14159   "RTN","RCD PESP2",160 ,0)
  14160    . ;
  14161   "RTN","RCD PESP2",161 ,0)
  14162    . S RCFND =$D(@RCDIR X@("DILIST ",1))  ; C HECK FOR R ECORDS RET URNED
  14163   "RTN","RCD PESP2",162 ,0)
  14164    . I 'RCFN D W !,"No  Auto-decre ase Exclus ions to Di splay",!
  14165   "RTN","RCD PESP2",163 ,0)
  14166    . ; RECOR DS RETURNE D
  14167   "RTN","RCD PESP2",164 ,0)
  14168    . I RCFND  S RCIEN=0  F  S RCIE N=$O(@RCDI RX@("DILIS T",RCIEN))  Q:RCSTOP! ('RCIEN)   D
  14169   "RTN","RCD PESP2",165 ,0)
  14170    .. S RCTM P=$P(@RCDI RX@("DILIS T",RCIEN,0 ),U,2,7)
  14171   "RTN","RCD PESP2",166 ,0)
  14172    .. I $Y+4 >IOSL D HD RXAR(.08,R CTYPE) Q:R CSTOP
  14173   "RTN","RCD PESP2",167 ,0)
  14174    .. D DSPX CLSN(RCTMP )
  14175   "RTN","RCD PESP2",168 ,0)
  14176    ;
  14177   "RTN","RCD PESP2",169 ,0)
  14178    ; end of  report
  14179   "RTN","RCD PESP2",170 ,0)
  14180    W !!,$$EN DORPRT^RCD PEARL
  14181   "RTN","RCD PESP2",171 ,0)
  14182    D ASK^RCD PEARL(.RCS TOP)
  14183   "RTN","RCD PESP2",172 ,0)
  14184    ;
  14185   "RTN","RCD PESP2",173 ,0)
  14186   RPT2Q ;
  14187   "RTN","RCD PESP2",174 ,0)
  14188    K @RCDIGE T,@RCDIMED ,@RCDIRX   ; clean up
  14189   "RTN","RCD PESP2",175 ,0)
  14190    Q
  14191   "RTN","RCD PESP2",176 ,0)
  14192    ;
  14193   "RTN","RCD PESP2",177 ,0)
  14194   GETPAYER()  ; GET THE  PAYER NAM E + PAYER  ID
  14195   "RTN","RCD PESP2",178 ,0)
  14196    N RCIEN,R CPAYR
  14197   "RTN","RCD PESP2",179 ,0)
  14198    S RCIEN=$ P(RCTMP,U, 6)
  14199   "RTN","RCD PESP2",180 ,0)
  14200    I '$D(^RC Y(344.6,RC IEN)) Q ""
  14201   "RTN","RCD PESP2",181 ,0)
  14202    S RCPAYR= $$GET1^DIQ (344.6,RCI EN_",",.01 )_" "_$$GE T1^DIQ(344 .6,RCIEN_" ,",.02)
  14203   "RTN","RCD PESP2",182 ,0)
  14204    Q RCPAYR
  14205   "RTN","RCD PESP2",183 ,0)
  14206    ;
  14207   "RTN","RCD PESP2",184 ,0)
  14208   HDRXAR(RCT YP,RCTYPD)  ; Report  header for  exclusin  auto repor t
  14209   "RTN","RCD PESP2",185 ,0)
  14210    ;   RCTYP  -   .06 =  AUTO-POST ING EXCLUS ION (medic al)
  14211   "RTN","RCD PESP2",186 ,0)
  14212    ;              .07 =  AUTO-DECR EASE EXCLU SION (medi cal)
  14213   "RTN","RCD PESP2",187 ,0)
  14214    ;              .08 =  AUTO-POST ING EXCLUS ION (pharm acy)
  14215   "RTN","RCD PESP2",188 ,0)
  14216    ;   RCTYP D  - M = M edical
  14217   "RTN","RCD PESP2",189 ,0)
  14218    ;              P = P harmacy
  14219   "RTN","RCD PESP2",190 ,0)
  14220    ;              B = B oth
  14221   "RTN","RCD PESP2",191 ,0)
  14222    ;
  14223   "RTN","RCD PESP2",192 ,0)
  14224    N RCTYPED
  14225   "RTN","RCD PESP2",193 ,0)
  14226    S RCTYPED =$S(RCTYPD ="M":"MEDI CAL",RCTYP D="P":"PHA RMACY",1:" ALL")
  14227   "RTN","RCD PESP2",194 ,0)
  14228    ;
  14229   "RTN","RCD PESP2",195 ,0)
  14230    I RCEXCEL  D  Q
  14231   "RTN","RCD PESP2",196 ,0)
  14232    .Q:RCHDR( "PAGE")
  14233   "RTN","RCD PESP2",197 ,0)
  14234    .; Excel  header for  parameter  audits
  14235   "RTN","RCD PESP2",198 ,0)
  14236    .W !!,"TY PE^CHANGE^ PAYER^TIME STAMP^USER ^COMMENT"
  14237   "RTN","RCD PESP2",199 ,0)
  14238    .S RCHDR( "PAGE")=1   ; only pr int it onc e
  14239   "RTN","RCD PESP2",200 ,0)
  14240    ;
  14241   "RTN","RCD PESP2",201 ,0)
  14242    I RCHDR(" PAGE") D A SK^RCDPEAR L(.RCSTOP)  Q:RCSTOP
  14243   "RTN","RCD PESP2",202 ,0)
  14244    W @IOF
  14245   "RTN","RCD PESP2",203 ,0)
  14246    S RCHDR(" PAGE")=RCH DR("PAGE") +1
  14247   "RTN","RCD PESP2",204 ,0)
  14248    ; report  header for  parameter  audits
  14249   "RTN","RCD PESP2",205 ,0)
  14250    W $$CNTR( "EDI Lockb ox Exclusi on Audit R eport"),?I OM-8,"Page : "_RCHDR( "PAGE")
  14251   "RTN","RCD PESP2",206 ,0)
  14252    W !,$$CNT R("DIVISIO NS: ALL")
  14253   "RTN","RCD PESP2",207 ,0)
  14254    W !,$$CNT R("RUN DAT E: "_$G(RC HDR("RUNDA TE")))
  14255   "RTN","RCD PESP2",208 ,0)
  14256    W !,$$CNT R("DATE RA NGE: "_$$F MTE^XLFDT( $P(RCRANGE ,U,2),"5D" )_" - "_$$ FMTE^XLFDT ($P(RCRANG E,U,3),"5D "))
  14257   "RTN","RCD PESP2",209 ,0)
  14258    W !,$$CNT R("REPORT  TYPE: "_RC TYPED)
  14259   "RTN","RCD PESP2",210 ,0)
  14260    D SECTHDR (RCTYP,RCT YPD)
  14261   "RTN","RCD PESP2",211 ,0)
  14262    Q
  14263   "RTN","RCD PESP2",212 ,0)
  14264    ;
  14265   "RTN","RCD PESP2",213 ,0)
  14266   SECTHDR(RC TYPE,RCREP T) ; SECTI ON HEADER
  14267   "RTN","RCD PESP2",214 ,0)
  14268    ;   RCTYP  - .06 = A UTO-POSTIN G EXCLUSIO N (medical )
  14269   "RTN","RCD PESP2",215 ,0)
  14270    ;            .07 = A UTO-DECREA SE EXCLUSI ON (medica l)
  14271   "RTN","RCD PESP2",216 ,0)
  14272    ;            .08 = A UTO-POSTIN G EXCLUSIO N (pharmac y)
  14273   "RTN","RCD PESP2",217 ,0)
  14274    ;   RCREP T - "M" =  "MEDICAL"
  14275   "RTN","RCD PESP2",218 ,0)
  14276    ;             "P" =  "PHARMACY"
  14277   "RTN","RCD PESP2",219 ,0)
  14278    Q:$G(RCEX CEL)
  14279   "RTN","RCD PESP2",220 ,0)
  14280    ;
  14281   "RTN","RCD PESP2",221 ,0)
  14282    I RCTYPE= .06 D
  14283   "RTN","RCD PESP2",222 ,0)
  14284    .W !!,"ME DICAL AUTO -POSTING P AYER EXCLU SION LIST"
  14285   "RTN","RCD PESP2",223 ,0)
  14286    .W !,"--- ---------- ---------- ---------- --------"
  14287   "RTN","RCD PESP2",224 ,0)
  14288    ;
  14289   "RTN","RCD PESP2",225 ,0)
  14290    I RCTYPE= .07 D
  14291   "RTN","RCD PESP2",226 ,0)
  14292    .W !!,"ME DICAL AUTO -DECREASE  PAYER EXCL USION LIST "
  14293   "RTN","RCD PESP2",227 ,0)
  14294    .W !,"--- ---------- ---------- ---------- ---------"
  14295   "RTN","RCD PESP2",228 ,0)
  14296    ;
  14297   "RTN","RCD PESP2",229 ,0)
  14298     I RCTYPE =.08 D
  14299   "RTN","RCD PESP2",230 ,0)
  14300    .W !!,"PH ARMACY AUT O-POSTING  PAYER EXCL USION LIST "
  14301   "RTN","RCD PESP2",231 ,0)
  14302    .W !,"--- ---------- ---------- ---------- ---------"
  14303   "RTN","RCD PESP2",232 ,0)
  14304    ;
  14305   "RTN","RCD PESP2",233 ,0)
  14306    W !,"Chan ge Payer                               Date /Time Edit ed   User"
  14307   "RTN","RCD PESP2",234 ,0)
  14308    W !,$TR($ J("",IOM-1 )," ","=")   ; row of  equal sig ns
  14309   "RTN","RCD PESP2",235 ,0)
  14310    Q
  14311   "RTN","RCD PESP2",236 ,0)
  14312    ;
  14313   "RTN","RCD PESP2",237 ,0)
  14314   CNTR(TXT)  ; center T XT
  14315   "RTN","RCD PESP2",238 ,0)
  14316    Q $J("",I OM-$L(TXT) \2)_TXT
  14317   "RTN","RCD PESP2",239 ,0)
  14318    ;
  14319   "RTN","RCD PESP2",240 ,0)
  14320   DTRNG() ;  function,  returns da te range f or the rep ort
  14321   "RTN","RCD PESP2",241 ,0)
  14322    N DIR,DUO UT,RNGFLG, X,Y,RCSTAR T,RCEND
  14323   "RTN","RCD PESP2",242 ,0)
  14324    S (RCSTAR T,RCEND)=0  D DATES(. RCSTART,.R CEND)
  14325   "RTN","RCD PESP2",243 ,0)
  14326    Q:RCSTART =-1 0
  14327   "RTN","RCD PESP2",244 ,0)
  14328    Q:RCSTART  "1^"_RCST ART_"^"_RC END
  14329   "RTN","RCD PESP2",245 ,0)
  14330    Q:'RCSTAR T "0^^"
  14331   "RTN","RCD PESP2",246 ,0)
  14332    Q 0
  14333   "RTN","RCD PESP2",247 ,0)
  14334    ;
  14335   "RTN","RCD PESP2",248 ,0)
  14336   DATES(BDAT E,EDATE) ;  Get a dat e range, b oth values  passed by  ref.
  14337   "RTN","RCD PESP2",249 ,0)
  14338    N DIR,DTO UT,DUOUT,X ,Y
  14339   "RTN","RCD PESP2",250 ,0)
  14340    S (BDATE, EDATE)=0
  14341   "RTN","RCD PESP2",251 ,0)
  14342    S DIR("?" )="Enter t he earlies t AUDIT DA TE to incl ude on the  report"
  14343   "RTN","RCD PESP2",252 ,0)
  14344    S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="Re port start  date: " D  ^DIR K DI R
  14345   "RTN","RCD PESP2",253 ,0)
  14346    I $D(DTOU T)!$D(DUOU T)!(Y="")  S BDATE=-1  Q
  14347   "RTN","RCD PESP2",254 ,0)
  14348    S BDATE=Y  K DIR,X,Y
  14349   "RTN","RCD PESP2",255 ,0)
  14350    S DIR("?" )="Enter t he latest  AUDIT DATE  to includ e on the r eport"
  14351   "RTN","RCD PESP2",256 ,0)
  14352    S DIR(0)= "DAO^"_BDA TE_":"_DT_ ":APE",DIR ("A")="Rep ort end da te: ",DIR( "B")=$$FMT E^XLFDT(DT )
  14353   "RTN","RCD PESP2",257 ,0)
  14354    D ^DIR K  DIR
  14355   "RTN","RCD PESP2",258 ,0)
  14356    I $D(DTOU T)!$D(DUOU T)!(Y="")  S BDATE=-1  Q
  14357   "RTN","RCD PESP2",259 ,0)
  14358    S EDATE=Y
  14359   "RTN","RCD PESP2",260 ,0)
  14360    Q
  14361   "RTN","RCD PESP2",261 ,0)
  14362    ;
  14363   "RTN","RCD PESP2",262 ,0)
  14364   DSPXCLSN(R CX) ; disp lay exclus ion
  14365   "RTN","RCD PESP2",263 ,0)
  14366    ; RCX - e xclusion v alue from  ^DIC call
  14367   "RTN","RCD PESP2",264 ,0)
  14368    N RCXCLSN
  14369   "RTN","RCD PESP2",265 ,0)
  14370    S RCXCLSN ("CHANGE") =$S($P(RCX ,U,3):"Add ed",1:"Rem oved")
  14371   "RTN","RCD PESP2",266 ,0)
  14372    S RCXCLSN ("TIME")=$ $FMTE^XLFD T($P(RCX,U ,2),"2")
  14373   "RTN","RCD PESP2",267 ,0)
  14374    S RCXCLSN ("USER")=$ P(RCX,U,4)
  14375   "RTN","RCD PESP2",268 ,0)
  14376    S RCXCLSN ("PAYER")= $$GETPAYER
  14377   "RTN","RCD PESP2",269 ,0)
  14378    S RCXCLSN ("COMMENT" )=$P(RCX,U ,5)
  14379   "RTN","RCD PESP2",270 ,0)
  14380    ;
  14381   "RTN","RCD PESP2",271 ,0)
  14382    I 'RCEXCE L D  Q
  14383   "RTN","RCD PESP2",272 ,0)
  14384    .N Y S Y= RCXCLSN("C HANGE"),$E (Y,9)=$E(R CXCLSN("PA YER"),1,30 ),$E(Y,41) =" "_RCXCL SN("TIME") ,Y=Y_" "_R CXCLSN("US ER")
  14385   "RTN","RCD PESP2",273 ,0)
  14386    .W !,Y,!, "  Comment : "_RCXCLS N("COMMENT ")
  14387   "RTN","RCD PESP2",274 ,0)
  14388    ; Excel f ormat
  14389   "RTN","RCD PESP2",275 ,0)
  14390    S RCXCLSN ("LABEL")= $$GET1^DID (344.6,$P( RCX,U,1),, "LABEL")
  14391   "RTN","RCD PESP2",276 ,0)
  14392    W !,RCXCL SN("LABEL" )_U_RCXCLS N("CHANGE" )_U_RCXCLS N("PAYER") _U_RCXCLSN ("TIME")_U _RCXCLSN(" USER")_U_R CXCLSN("CO MMENT")
  14393   "RTN","RCD PESP2",277 ,0)
  14394    ;
  14395   "RTN","RCD PESP2",278 ,0)
  14396    Q
  14397   "RTN","RCD PESP2",279 ,0)
  14398    ;
  14399   "RTN","RCD PESP2",280 ,0)
  14400    ;Retrieve  the param eter for t he type of  informati on to disp lay
  14401   "RTN","RCD PESP2",281 ,0)
  14402   RTYPE(DEF)  ;EP from  RCDPEAA1
  14403   "RTN","RCD PESP2",282 ,0)
  14404    ; Input:    DEF      - Value to  use a def ault
  14405   "RTN","RCD PESP2",283 ,0)
  14406    ; Returns : -1       - User ^ o r timed ou t
  14407   "RTN","RCD PESP2",284 ,0)
  14408    ;            M       - User sel ected MEDI CAL
  14409   "RTN","RCD PESP2",285 ,0)
  14410    ;            P       - User sel ected PHAR MACY
  14411   "RTN","RCD PESP2",286 ,0)
  14412    ;            B       - User sel ected BOTH
  14413   "RTN","RCD PESP2",287 ,0)
  14414    N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT,R CTYPE
  14415   "RTN","RCD PESP2",288 ,0)
  14416    S RCTYPE= ""
  14417   "RTN","RCD PESP2",289 ,0)
  14418    S DIR("?" )="Enter t he type of  informati on to disp lay on the  report"
  14419   "RTN","RCD PESP2",290 ,0)
  14420    S DIR(0)= "SA^M:MEDI CAL;P:PHAR MACY;B:BOT H"
  14421   "RTN","RCD PESP2",291 ,0)
  14422    S DIR("A" )="(M)EDIC AL, (P)HAR MACY, or ( B)OTH: "     ; PRCA*4 .5*317 cha nged 'OR'  to 'or'
  14423   "RTN","RCD PESP2",292 ,0)
  14424    S DIR("B" )=$S($G(DE F)'="":DEF ,1:"BOTH")
  14425   "RTN","RCD PESP2",293 ,0)
  14426    D ^DIR
  14427   "RTN","RCD PESP2",294 ,0)
  14428    K DIR
  14429   "RTN","RCD PESP2",295 ,0)
  14430    I $D(DTOU T)!$D(DUOU T) Q -1
  14431   "RTN","RCD PESP2",296 ,0)
  14432    Q:Y="" "B "
  14433   "RTN","RCD PESP2",297 ,0)
  14434    Q $E(Y)
  14435   "RTN","RCD PESP2",298 ,0)
  14436    ;
  14437   "RTN","RCD PESP2",299 ,0)
  14438    ;Check to  see if th e Data ele ment match es the rep ort type
  14439   "RTN","RCD PESP2",300 ,0)
  14440   RPTYPE(RCT YPE,RCPARA M) ;
  14441   "RTN","RCD PESP2",301 ,0)
  14442    ; Return  1 if valid  to print,  0 otherwi se
  14443   "RTN","RCD PESP2",302 ,0)
  14444    N RCDATA, RCMEN,RCRE N
  14445   "RTN","RCD PESP2",303 ,0)
  14446    ;
  14447   "RTN","RCD PESP2",304 ,0)
  14448    S (RCMEN, RCREN)=""
  14449   "RTN","RCD PESP2",305 ,0)
  14450    ; Get Aut o Decrease  parameter s
  14451   "RTN","RCD PESP2",306 ,0)
  14452    I RCTYPE= "M" S RCME N=$P($G(^R CY(344.61, 1,0)),U,3)
  14453   "RTN","RCD PESP2",307 ,0)
  14454    I RCTYPE= "P" S RCRE N=$P($G(^R CY(344.61, 1,1)),U,2)
  14455   "RTN","RCD PESP2",308 ,0)
  14456    ;
  14457   "RTN","RCD PESP2",309 ,0)
  14458    Q:RCTYPE= "B" 1
  14459   "RTN","RCD PESP2",310 ,0)
  14460    Q:(RCTYPE ="M")&(RCP ARAM["MED" ) 1        ; Medical  Parameters
  14461   "RTN","RCD PESP2",311 ,0)
  14462    Q:(RCTYPE ="P")&(RCP ARAM["RX")  1         ; Pharmacy  parameter s
  14463   "RTN","RCD PESP2",312 ,0)
  14464    Q:(RCTYPE ="P")&(RCP ARAM["PHAR M") 1         ; Pharm acy parame ters
  14465   "RTN","RCD PESP2",313 ,0)
  14466    Q:(RCTYPE ="M")&(RCM EN)&(RCPAR AM["DECREA SE") 1          ; Aut o-decrease  for med i s on
  14467   "RTN","RCD PESP2",314 ,0)
  14468    Q:(RCTYPE ="P")&(RCR EN)&(RCPAR AM["DECREA SE") 1          ; Aut o-decrease  for pharm acy
  14469   "RTN","RCD PESP2",315 ,0)
  14470    Q 0
  14471   "RTN","RCD PESP2",316 ,0)
  14472    ;
  14473   "RTN","RCD PESP5")
  14474   0^27^B2689 46794
  14475   "RTN","RCD PESP5",1,0 )
  14476   RCDPESP5 ; ALB/SAB -  ePayment L ockbox Sit e Paramete rs Definit ion - File s 344.71 ; 17 Oct 201 8 18:52:41
  14477   "RTN","RCD PESP5",2,0 )
  14478    ;;4.5;Acc ounts Rece ivable;**3 04,321,326 ,332**;Mar  20, 1995; Build 34
  14479   "RTN","RCD PESP5",3,0 )
  14480    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  14481   "RTN","RCD PESP5",4,0 )
  14482    ;
  14483   "RTN","RCD PESP5",5,0 )
  14484    Q
  14485   "RTN","RCD PESP5",6,0 )
  14486    ;
  14487   "RTN","RCD PESP5",7,0 )
  14488   CARC(RCQUI T,PAID) ;U pdate the  CARC/RARC  inclusion  table
  14489   "RTN","RCD PESP5",8,0 )
  14490    ; INPUT    RCQUIT -  Added RCQU IT as inpu t paramete r - PRCA*4 .5*321
  14491   "RTN","RCD PESP5",9,0 )
  14492    ;          PAID 1 =  payment li nes  0 = n o-payment  lines - PR CA*4.5*326
  14493   "RTN","RCD PESP5",10, 0)
  14494    ;initiali ze
  14495   "RTN","RCD PESP5",11, 0)
  14496    N RCANS,R CCARC,RCCH G,RCCDATA, RCCIEN,RCE DIT,RCRSN, RCSTAT
  14497   "RTN","RCD PESP5",12, 0)
  14498    N RCAMT,R CNAMT,RCAU DARY,RCCAR CDS,RCYN,R CVAL,RCINA CT,RCACTV, RCTXT
  14499   "RTN","RCD PESP5",13, 0)
  14500    S RCEDIT= "",RCANS=" "
  14501   "RTN","RCD PESP5",14, 0)
  14502    ;
  14503   "RTN","RCD PESP5",15, 0)
  14504    S RCTXT=$ S(PAID:"", 1:"NO-PAY  ") ; PRCA* 4.5*326
  14505   "RTN","RCD PESP5",16, 0)
  14506    ;Display  initial en try line.
  14507   "RTN","RCD PESP5",17, 0)
  14508    W !,"AUTO -DECREASE  "_RCTXT_"M EDICAL CLA IMS FOR TH E FOLLOWIN G CARC/AMO UNTS ONLY: ",!
  14509   "RTN","RCD PESP5",18, 0)
  14510    ;
  14511   "RTN","RCD PESP5",19, 0)
  14512    ;
  14513   "RTN","RCD PESP5",20, 0)
  14514    ;Loop unt il the use r quits
  14515   "RTN","RCD PESP5",21, 0)
  14516    F  D  Q:R CANS="Q"
  14517   "RTN","RCD PESP5",22, 0)
  14518    . ;
  14519   "RTN","RCD PESP5",23, 0)
  14520    . ;displa y list of  currently  enabled/di sabled CAR Cs/RARCs
  14521   "RTN","RCD PESP5",24, 0)
  14522    . D PRTCA RC(PAID) ;  PRCA*4.5* 326
  14523   "RTN","RCD PESP5",25, 0)
  14524    . ;
  14525   "RTN","RCD PESP5",26, 0)
  14526    . ; add s ome spacin g
  14527   "RTN","RCD PESP5",27, 0)
  14528    . W !!
  14529   "RTN","RCD PESP5",28, 0)
  14530    . ;
  14531   "RTN","RCD PESP5",29, 0)
  14532    . ;Ask us er for the  CARC/RARC  to enable /disable ( QUIT) [def ault] to e xit
  14533   "RTN","RCD PESP5",30, 0)
  14534    . ;
  14535   "RTN","RCD PESP5",31, 0)
  14536    . S RCCAR C=$$GETCAR C()
  14537   "RTN","RCD PESP5",32, 0)
  14538    . I RCCAR C=-1 S RCQ UIT=1,RCAN S="Q" Q
  14539   "RTN","RCD PESP5",33, 0)
  14540    . I RCCAR C=0 S RCAN S="Q" Q
  14541   "RTN","RCD PESP5",34, 0)
  14542    . ;
  14543   "RTN","RCD PESP5",35, 0)
  14544    . ;Valida te CARC en tered
  14545   "RTN","RCD PESP5",36, 0)
  14546    . S RCVAL =$$VAL^RCD PCRR(345,R CCARC)  ;  Validate t he CARC ag ainst File  345
  14547   "RTN","RCD PESP5",37, 0)
  14548    . S RCACT V=$$ACT^RC DPRU(345,R CCARC,)  ;  Check if  CARC is an  active co de
  14549   "RTN","RCD PESP5",38, 0)
  14550    . ;
  14551   "RTN","RCD PESP5",39, 0)
  14552    . ;If the  CARC is i nvalid, wa rn user an d exit bac k to the C ARC prompt
  14553   "RTN","RCD PESP5",40, 0)
  14554    . I 'RCVA L W !,"The  CARC code  you have  entered is  not a val id CARC co de.  Pleas e try agai n" Q
  14555   "RTN","RCD PESP5",41, 0)
  14556    . ;
  14557   "RTN","RCD PESP5",42, 0)
  14558    . ; Print  CARC and  descriptio n and init ialize ina ctive vari able
  14559   "RTN","RCD PESP5",43, 0)
  14560    . S RCCAR CDS="",RCI NACT=""
  14561   "RTN","RCD PESP5",44, 0)
  14562    . D GETCO DES^RCDPCR R(RCCARC," ","A",$$DT ^XLFDT,"RC CARCDS","1 ^70")
  14563   "RTN","RCD PESP5",45, 0)
  14564    . I $D(RC CARCDS("CA RC",RCCARC ))'=10 D
  14565   "RTN","RCD PESP5",46, 0)
  14566    . . S RCI NACT=1
  14567   "RTN","RCD PESP5",47, 0)
  14568    . . D GET CODES^RCDP CRR(RCCARC ,"","I",$$ DT^XLFDT," RCCARCDS", "1^70")
  14569   "RTN","RCD PESP5",48, 0)
  14570    . S RCCIE N=$O(RCCAR CDS("CARC" ,RCCARC,"" ))
  14571   "RTN","RCD PESP5",49, 0)
  14572    . S RCDES C=$P(RCCAR CDS("CARC" ,RCCARC,RC CIEN),U,6)
  14573   "RTN","RCD PESP5",50, 0)
  14574    . ;
  14575   "RTN","RCD PESP5",51, 0)
  14576    . ; If th e descript ion is 70  characters , add elli psis to th e string t o indicate  there is  more to th e descript ion
  14577   "RTN","RCD PESP5",52, 0)
  14578    . S:$E(RC DESC)=70 R CDESC=RCDE SC_" ..."
  14579   "RTN","RCD PESP5",53, 0)
  14580    . W !,?3, RCDESC,!
  14581   "RTN","RCD PESP5",54, 0)
  14582    . I 'RCAC TV W "   * ** WARNING : CARC cod e "_RCCARC _" is no l onger acti ve.",!
  14583   "RTN","RCD PESP5",55, 0)
  14584    . ;
  14585   "RTN","RCD PESP5",56, 0)
  14586    . ; Look  up CARC/RA RC in tabl e.
  14587   "RTN","RCD PESP5",57, 0)
  14588    . S RCCIE N=$O(^RCY( 344.62,"B" ,RCCARC,"" ))
  14589   "RTN","RCD PESP5",58, 0)
  14590    . S (RCAM T,RCSTAT)= 0  ; Initi alize if n ew code en try for ta ble
  14591   "RTN","RCD PESP5",59, 0)
  14592    . I RCCIE N D          ; Code e xists in t able
  14593   "RTN","RCD PESP5",60, 0)
  14594    . . ; BEG IN - PRCA* 4.5*326
  14595   "RTN","RCD PESP5",61, 0)
  14596    . . ; Get  current p ayment Aut o-decrease  status an d Max decr ease amoun t
  14597   "RTN","RCD PESP5",62, 0)
  14598    . . I PAI D=1 D  ; P ayment lin es
  14599   "RTN","RCD PESP5",63, 0)
  14600    . . . S R CSTAT=$$GE T1^DIQ(344 .62,RCCIEN ,.02,"I")
  14601   "RTN","RCD PESP5",64, 0)
  14602    . . . S R CAMT=$$GET 1^DIQ(344. 62,RCCIEN, .06)
  14603   "RTN","RCD PESP5",65, 0)
  14604    . . I PAI D=0 D  ; N o payment  lines
  14605   "RTN","RCD PESP5",66, 0)
  14606    . . . S R CSTAT=$$GE T1^DIQ(344 .62,RCCIEN ,.08,"I")
  14607   "RTN","RCD PESP5",67, 0)
  14608    . . . S R CAMT=$$GET 1^DIQ(344. 62,RCCIEN, .12)
  14609   "RTN","RCD PESP5",68, 0)
  14610    . . ; END  - PRCA*4. 5*326 
  14611   "RTN","RCD PESP5",69, 0)
  14612    . ;
  14613   "RTN","RCD PESP5",70, 0)
  14614    . ; Init  Audit arra y to send  each updat e individu ally
  14615   "RTN","RCD PESP5",71, 0)
  14616    . S RCAUD ARY(1)=""
  14617   "RTN","RCD PESP5",72, 0)
  14618    . S RCAUD ARY(2)=""
  14619   "RTN","RCD PESP5",73, 0)
  14620    . ;
  14621   "RTN","RCD PESP5",74, 0)
  14622    . ; If pr esent and  enabled
  14623   "RTN","RCD PESP5",75, 0)
  14624    . I RCCIE N,RCSTAT D   Q
  14625   "RTN","RCD PESP5",76, 0)
  14626    . . ;
  14627   "RTN","RCD PESP5",77, 0)
  14628    . . S RCN AMT=0,RCRS N=""  ;Ini tialize va riables
  14629   "RTN","RCD PESP5",78, 0)
  14630    . . ;
  14631   "RTN","RCD PESP5",79, 0)
  14632    . . ; Con firm that  this is th e correct  CARC
  14633   "RTN","RCD PESP5",80, 0)
  14634    . . S RCY N=$$CONFIR M(4,PAID)  ; Added PA ID - PRCA* 4.5*326
  14635   "RTN","RCD PESP5",81, 0)
  14636    . . Q:RCY N=-1
  14637   "RTN","RCD PESP5",82, 0)
  14638    . . ;
  14639   "RTN","RCD PESP5",83, 0)
  14640    . . ; Ask  for reaso n
  14641   "RTN","RCD PESP5",84, 0)
  14642    . . S RCR SN=$$GETRE ASN(RCCARC )
  14643   "RTN","RCD PESP5",85, 0)
  14644    . . Q:RCR SN=-1   ;  User reque sted to qu it
  14645   "RTN","RCD PESP5",86, 0)
  14646    . . ;
  14647   "RTN","RCD PESP5",87, 0)
  14648    . . ; Con firm the d isabling
  14649   "RTN","RCD PESP5",88, 0)
  14650    . . S RCY N=$$CONFIR M(3,PAID)  ; Added PA ID - PRCA* 4.5*326
  14651   "RTN","RCD PESP5",89, 0)
  14652    . . Q:RCY N=-1
  14653   "RTN","RCD PESP5",90, 0)
  14654    . . ;
  14655   "RTN","RCD PESP5",91, 0)
  14656    . . D UPD DATA(RCCIE N,0,RCAMT, RCRSN,PAID ) ; If dis abling - P AID added  PRCA*4.5*3 26
  14657   "RTN","RCD PESP5",92, 0)
  14658    . . ;
  14659   "RTN","RCD PESP5",93, 0)
  14660    . . ;At l east 1 ite m was chan ge/updated /added so  set flag f or reprint
  14661   "RTN","RCD PESP5",94, 0)
  14662    . . I 'RC EDIT S RCE DIT=1
  14663   "RTN","RCD PESP5",95, 0)
  14664    . . ;
  14665   "RTN","RCD PESP5",96, 0)
  14666    . . ;Don' t need a s econd entr y in the a udit file  so kill it  to preven t audit lo gging from  crashing
  14667   "RTN","RCD PESP5",97, 0)
  14668    . . K RCA UDARY(2)
  14669   "RTN","RCD PESP5",98, 0)
  14670    . . ;
  14671   "RTN","RCD PESP5",99, 0)
  14672    . . ; Upd ate audit  log for di sable CARC
  14673   "RTN","RCD PESP5",100 ,0)
  14674    . . ; Ord er - File  ; Field ;  IEN ; New  Value ; Ol d Value ;  Comment
  14675   "RTN","RCD PESP5",101 ,0)
  14676    . . S FIE LD=$S(PAID :.02,1:.08 ) ; PRCA*4 .5*326
  14677   "RTN","RCD PESP5",102 ,0)
  14678    . . S RCA UDARY(1)=" 344.62^"_F IELD_"^"_R CCIEN_"^0^ 1^"_RCRSN  ; PRCA*4.5 *326
  14679   "RTN","RCD PESP5",103 ,0)
  14680    . . D AUD IT^RCDPESP (.RCAUDARY )
  14681   "RTN","RCD PESP5",104 ,0)
  14682    . ;
  14683   "RTN","RCD PESP5",105 ,0)
  14684    . ; Confi rm that th is is the  correct CA RC to Enab le
  14685   "RTN","RCD PESP5",106 ,0)
  14686    . S RCYN= $$CONFIRM( 1,PAID) ;  Added PAID  - PRCA*4. 5*326
  14687   "RTN","RCD PESP5",107 ,0)
  14688    . Q:RCYN= -1
  14689   "RTN","RCD PESP5",108 ,0)
  14690    . ;
  14691   "RTN","RCD PESP5",109 ,0)
  14692    . ; Ask f or new amo unt
  14693   "RTN","RCD PESP5",110 ,0)
  14694    . S RCNAM T=$$GETAMT ()
  14695   "RTN","RCD PESP5",111 ,0)
  14696    . Q:RCNAM T=-1   ; U ser reques ted to qui t
  14697   "RTN","RCD PESP5",112 ,0)
  14698    . ;
  14699   "RTN","RCD PESP5",113 ,0)
  14700    . ; Ask f or reason
  14701   "RTN","RCD PESP5",114 ,0)
  14702    . S RCRSN =$$GETREAS N(RCCARC)
  14703   "RTN","RCD PESP5",115 ,0)
  14704    . Q:RCRSN =-1   ; Us er request ed to quit
  14705   "RTN","RCD PESP5",116 ,0)
  14706    . ;
  14707   "RTN","RCD PESP5",117 ,0)
  14708    . ; Confi rm save
  14709   "RTN","RCD PESP5",118 ,0)
  14710    . S RCYN= $$CONFIRM( 2,PAID) ;  Added PAID  - PRCA*4. 5*326
  14711   "RTN","RCD PESP5",119 ,0)
  14712    . I (RCYN ="N")!(RCY N=-1) W !, "NOT SAVED ",!! Q
  14713   "RTN","RCD PESP5",120 ,0)
  14714    . ;   
  14715   "RTN","RCD PESP5",121 ,0)
  14716    . ; Re-en able if di sabled and  quit
  14717   "RTN","RCD PESP5",122 ,0)
  14718    . I RCCIE N D  Q
  14719   "RTN","RCD PESP5",123 ,0)
  14720    . . D UPD DATA(RCCIE N,1,RCNAMT ,RCRSN,PAI D)  ; Rena ble and up date amoun t - PAID a dded PRCA* 4.5*326
  14721   "RTN","RCD PESP5",124 ,0)
  14722    . . ;
  14723   "RTN","RCD PESP5",125 ,0)
  14724    . . ;Upda te audit f ile with r eason and  amount cha nges.
  14725   "RTN","RCD PESP5",126 ,0)
  14726    . . ; Ord er - File  ; Field ;  IEN ; New  Value ; Ol d Value ;  Comment
  14727   "RTN","RCD PESP5",127 ,0)
  14728    . . S FIE LD=$S(PAID :.02,1:.08 ) ; PRCA*4 .5*326
  14729   "RTN","RCD PESP5",128 ,0)
  14730    . . S RCA UDARY(1)=" 344.62^"_F IELD_"^"_R CCIEN_"^1^ "_RCSTAT_" ^"_RCRSN ;  PRCA*4.5* 326
  14731   "RTN","RCD PESP5",129 ,0)
  14732    . . S FIE LD=$S(PAID :.06,1:.12 ) ; PRCA*4 .5*326
  14733   "RTN","RCD PESP5",130 ,0)
  14734    . . S RCA UDARY(2)=" 344.62^"_F IELD_"^"_R CCIEN_"^"_ RCNAMT_"^" _RCAMT_"^" _RCRSN ; P RCA*4.5*32 6
  14735   "RTN","RCD PESP5",131 ,0)
  14736    . . D AUD IT^RCDPESP (.RCAUDARY )
  14737   "RTN","RCD PESP5",132 ,0)
  14738    . . ;
  14739   "RTN","RCD PESP5",133 ,0)
  14740    . . ;At l east 1 ite m was chan ge/updated /added so  set flag f or reprint
  14741   "RTN","RCD PESP5",134 ,0)
  14742    . . I 'RC EDIT S RCE DIT=1
  14743   "RTN","RCD PESP5",135 ,0)
  14744    . ;
  14745   "RTN","RCD PESP5",136 ,0)
  14746    . ; Store  new entry
  14747   "RTN","RCD PESP5",137 ,0)
  14748    . D ADDDA TA(RCCARC, RCNAMT,RCR SN,PAID) ;  PAID adde d PRCA*4.5 *326
  14749   "RTN","RCD PESP5",138 ,0)
  14750    . ;
  14751   "RTN","RCD PESP5",139 ,0)
  14752    . ;Update  audit fil e with rea son and am ount chang es.
  14753   "RTN","RCD PESP5",140 ,0)
  14754    . S RCCIE N=$$FIND1^ DIC(344.62 ,"","",RCC ARC,"","", "RCERR") I  RCCIEN=""  S RCCIEN= "ERROR"
  14755   "RTN","RCD PESP5",141 ,0)
  14756    . ;
  14757   "RTN","RCD PESP5",142 ,0)
  14758    . ; Order  - File ;  Field ; IE N ; New Va lue ; Old  Value ; Co mment
  14759   "RTN","RCD PESP5",143 ,0)
  14760    . S FIELD =$S(PAID:. 02,1:.08)  ; PRCA*4.5 *326
  14761   "RTN","RCD PESP5",144 ,0)
  14762    . S RCAUD ARY(1)="34 4.62^"_FIE LD_"^"_RCC IEN_"^1^0^ "_RCRSN ;  PRCA*4.5*3 26
  14763   "RTN","RCD PESP5",145 ,0)
  14764    . S FIELD =$S(PAID:. 06,1:.12)  ; PRCA*4.5 *326
  14765   "RTN","RCD PESP5",146 ,0)
  14766    . S RCAUD ARY(2)="34 4.62^"_FIE LD_"^"_RCC IEN_"^"_RC NAMT_"^0^" _RCRSN ; P RCA*4.5*32 6
  14767   "RTN","RCD PESP5",147 ,0)
  14768    . D AUDIT ^RCDPESP(. RCAUDARY)
  14769   "RTN","RCD PESP5",148 ,0)
  14770    . ;
  14771   "RTN","RCD PESP5",149 ,0)
  14772    . ;At lea st 1 item  was change /updated/a dded so se t flag for  reprint
  14773   "RTN","RCD PESP5",150 ,0)
  14774    . I 'RCED IT S RCEDI T=1
  14775   "RTN","RCD PESP5",151 ,0)
  14776    ;
  14777   "RTN","RCD PESP5",152 ,0)
  14778    Q
  14779   "RTN","RCD PESP5",153 ,0)
  14780    ;
  14781   "RTN","RCD PESP5",154 ,0)
  14782   PRTCARC(PA ID) ;Displ ay current  entries t hat have b een define d for incl usion or e xclusion i nto - PAID  added - P RCA*4.5*32 6
  14783   "RTN","RCD PESP5",155 ,0)
  14784    ;
  14785   "RTN","RCD PESP5",156 ,0)
  14786    N FIELD,R CI,RCCT,RC STRING,RCD ATA,RCINAC T,RCCARCD, RCDESC,RCC IEN,RCSTAT ,RCCODE
  14787   "RTN","RCD PESP5",157 ,0)
  14788    ;
  14789   "RTN","RCD PESP5",158 ,0)
  14790    S RCI=0,R CCT=0,RCST RING=""
  14791   "RTN","RCD PESP5",159 ,0)
  14792    S RCSTRIN G=$TR($J(" ",73)," ", "-")
  14793   "RTN","RCD PESP5",160 ,0)
  14794    ;
  14795   "RTN","RCD PESP5",161 ,0)
  14796    ; Print H eader
  14797   "RTN","RCD PESP5",162 ,0)
  14798    ;
  14799   "RTN","RCD PESP5",163 ,0)
  14800    W !!,?3," CARC ",?9, "Descripti on",?65,"M ax. Amt"
  14801   "RTN","RCD PESP5",164 ,0)
  14802    W !,?3,RC STRING
  14803   "RTN","RCD PESP5",165 ,0)
  14804    ;
  14805   "RTN","RCD PESP5",166 ,0)
  14806    ; Loop an d print en tries
  14807   "RTN","RCD PESP5",167 ,0)
  14808    F  S RCI= $O(^RCY(34 4.62,RCI))  Q:'RCI  D
  14809   "RTN","RCD PESP5",168 ,0)
  14810    . S RCDAT A=$G(^RCY( 344.62,RCI ,0))
  14811   "RTN","RCD PESP5",169 ,0)
  14812    . Q:RCDAT A=""
  14813   "RTN","RCD PESP5",170 ,0)
  14814    . S RCCOD E=$P(RCDAT A,U),RCCIE N=$O(^RC(3 45,"B",RCC ODE,""))
  14815   "RTN","RCD PESP5",171 ,0)
  14816    . S RCDES C=$G(^RC(3 45,RCCIEN, 1,1,0))
  14817   "RTN","RCD PESP5",172 ,0)
  14818    . S FIELD =$S(PAID:. 02,1:.08)
  14819   "RTN","RCD PESP5",173 ,0)
  14820    . S RCSTA T=$$GET1^D IQ(344.62, RCI,FIELD, "I")
  14821   "RTN","RCD PESP5",174 ,0)
  14822    . Q:RCSTA T'=1
  14823   "RTN","RCD PESP5",175 ,0)
  14824    . S RCCT= RCCT+1
  14825   "RTN","RCD PESP5",176 ,0)
  14826    . I $L(RC DESC)>50 S  RCDESC=$E (RCDESC,1, 50)_" ..."
  14827   "RTN","RCD PESP5",177 ,0)
  14828    . D GETCO DES^RCDPCR R(RCCODE," ","B",$$DT ^XLFDT,"RC CARCD","1^ 70")
  14829   "RTN","RCD PESP5",178 ,0)
  14830    . S FIELD =$S(PAID:. 06,1:.12)
  14831   "RTN","RCD PESP5",179 ,0)
  14832    . W !,?3, RCCODE,?9, $E(RCDESC, 1,55),?63, $J($$GET1^ DIQ(344.62 ,RCI,FIELD ,"I"),10,0 )
  14833   "RTN","RCD PESP5",180 ,0)
  14834    . I $P(RC CARCD("CAR C",RCCODE, RCCIEN),U, 3)'="" W "  (I)"  ; i f inactive , display  (I)
  14835   "RTN","RCD PESP5",181 ,0)
  14836    . K RCCAR CD
  14837   "RTN","RCD PESP5",182 ,0)
  14838    ;
  14839   "RTN","RCD PESP5",183 ,0)
  14840    I RCCT=0  W !,?5,"NO  CARC/AMOU NTS ENTERE D"
  14841   "RTN","RCD PESP5",184 ,0)
  14842    Q
  14843   "RTN","RCD PESP5",185 ,0)
  14844    ;
  14845   "RTN","RCD PESP5",186 ,0)
  14846    ;Retrieve  the next  CARC code  to enable/ disable
  14847   "RTN","RCD PESP5",187 ,0)
  14848   GETCARC()  ;
  14849   "RTN","RCD PESP5",188 ,0)
  14850    N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT
  14851   "RTN","RCD PESP5",189 ,0)
  14852    S DIR("?" )="Enter a  CARC code  to enable /disable o r Q to Qui t."
  14853   "RTN","RCD PESP5",190 ,0)
  14854    S DIR(0)= "FAO"
  14855   "RTN","RCD PESP5",191 ,0)
  14856    S DIR("?? ")="^D LIS T^RCDPCRR( 345)"
  14857   "RTN","RCD PESP5",192 ,0)
  14858    S DIR("A" )="CARC: "
  14859   "RTN","RCD PESP5",193 ,0)
  14860    D ^DIR
  14861   "RTN","RCD PESP5",194 ,0)
  14862    K DIR
  14863   "RTN","RCD PESP5",195 ,0)
  14864    I $D(DTOU T)!$D(DUOU T) Q -1
  14865   "RTN","RCD PESP5",196 ,0)
  14866    I Y="" Q  0
  14867   "RTN","RCD PESP5",197 ,0)
  14868    Q Y
  14869   "RTN","RCD PESP5",198 ,0)
  14870    ;
  14871   "RTN","RCD PESP5",199 ,0)
  14872    ;Ask user  to change  or disabl e an enabl ed CARC au to-decreme nt
  14873   "RTN","RCD PESP5",200 ,0)
  14874   CHGDIS() ;
  14875   "RTN","RCD PESP5",201 ,0)
  14876    N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT
  14877   "RTN","RCD PESP5",202 ,0)
  14878    S DIR("?" )="Either  (D)isable  the CARC f rom Auto-D ecrease or  (C)hange  the maximu m amount o f Auto-Dec rease."
  14879   "RTN","RCD PESP5",203 ,0)
  14880    S DIR(0)= "FA"
  14881   "RTN","RCD PESP5",204 ,0)
  14882    S DIR("A" )="(C)hang e or (D)is able: "
  14883   "RTN","RCD PESP5",205 ,0)
  14884    S DIR("S" )="C:Chang e;D:Disabl e"
  14885   "RTN","RCD PESP5",206 ,0)
  14886    D ^DIR
  14887   "RTN","RCD PESP5",207 ,0)
  14888    K DIR
  14889   "RTN","RCD PESP5",208 ,0)
  14890    Q Y
  14891   "RTN","RCD PESP5",209 ,0)
  14892    ;
  14893   "RTN","RCD PESP5",210 ,0)
  14894    ;Ask user  to change  or disabl e an enabl ed CARC au to-decreme nt
  14895   "RTN","RCD PESP5",211 ,0)
  14896   CONFIRM(RC IDX,PAID)  ; Added PA ID - PRCA* 4.5*326
  14897   "RTN","RCD PESP5",212 ,0)
  14898    N DA,DIR, DTOUT,DUOU T,DIRUT,DI ROUT,RCTXT ,X,Y
  14899   "RTN","RCD PESP5",213 ,0)
  14900    ;
  14901   "RTN","RCD PESP5",214 ,0)
  14902    S RCTXT=$ S(PAID:"", 1:"NO-PAY  ") ; PRCA* 4.5*326
  14903   "RTN","RCD PESP5",215 ,0)
  14904    ; Confirm  if the CA RC code is  correct
  14905   "RTN","RCD PESP5",216 ,0)
  14906    I RCIDX=1  D
  14907   "RTN","RCD PESP5",217 ,0)
  14908    . S DIR(" ?")="Eithe r (Y)es to  confirm t hat this i s the corr ect code o r (N)o to  enter a di fferent co de."
  14909   "RTN","RCD PESP5",218 ,0)
  14910    . S DIR(" A")="ENABL E this CAR C for Auto -Decrease  of "_RCTXT _"Medical  Claims (Y/ N)? "
  14911   "RTN","RCD PESP5",219 ,0)
  14912    ;
  14913   "RTN","RCD PESP5",220 ,0)
  14914    ; Confirm  if the us er wishes  to Enable  the change s
  14915   "RTN","RCD PESP5",221 ,0)
  14916    I RCIDX=2  D
  14917   "RTN","RCD PESP5",222 ,0)
  14918    . S DIR(" ?")="Eithe r (Y)es to  confirm c hanges or  (N)o to ex it without  saving."
  14919   "RTN","RCD PESP5",223 ,0)
  14920    . S DIR(" A")="Save  this CARC?  (Y)es or  (N)o: "
  14921   "RTN","RCD PESP5",224 ,0)
  14922    ;
  14923   "RTN","RCD PESP5",225 ,0)
  14924    ; Confirm  if the us er wishes  to Disable  the chang es
  14925   "RTN","RCD PESP5",226 ,0)
  14926    I RCIDX=3  D
  14927   "RTN","RCD PESP5",227 ,0)
  14928    . S DIR(" ?")="Eithe r (Y)es to  confirm c hanges or  (N)o to ex it without  saving."
  14929   "RTN","RCD PESP5",228 ,0)
  14930    . S DIR(" A")="Remov e this CAR C? (Y)es o r (N)o: "
  14931   "RTN","RCD PESP5",229 ,0)
  14932    ;
  14933   "RTN","RCD PESP5",230 ,0)
  14934    ; Confirm  if the CA RC code is  correct
  14935   "RTN","RCD PESP5",231 ,0)
  14936    I RCIDX=4  D
  14937   "RTN","RCD PESP5",232 ,0)
  14938    . S DIR(" ?")="Eithe r (Y)es to  confirm t hat this i s the corr ect code o r (N)o to  enter a di fferent co de."
  14939   "RTN","RCD PESP5",233 ,0)
  14940    . S DIR(" A")="DISAB LE this CA RC for Aut o-Decrease  of "_RCTX T_"Medical  Claims (Y /N)? "
  14941   "RTN","RCD PESP5",234 ,0)
  14942    ;
  14943   "RTN","RCD PESP5",235 ,0)
  14944    S DIR(0)= "YA"
  14945   "RTN","RCD PESP5",236 ,0)
  14946    S DIR("S" )="Y:Yes;N :No"
  14947   "RTN","RCD PESP5",237 ,0)
  14948    D ^DIR
  14949   "RTN","RCD PESP5",238 ,0)
  14950    K DIR
  14951   "RTN","RCD PESP5",239 ,0)
  14952    I $G(DTOU T)!$G(DUOU T) S Y=-1
  14953   "RTN","RCD PESP5",240 ,0)
  14954    I Y="0" S  Y=-1
  14955   "RTN","RCD PESP5",241 ,0)
  14956    Q Y
  14957   "RTN","RCD PESP5",242 ,0)
  14958    ;
  14959   "RTN","RCD PESP5",243 ,0)
  14960    ;Ask user  the maxim um amount  to allow f or auto-de crease
  14961   "RTN","RCD PESP5",244 ,0)
  14962   GETAMT() ;
  14963   "RTN","RCD PESP5",245 ,0)
  14964    ; BEGIN P RCA*4.5*32 6
  14965   "RTN","RCD PESP5",246 ,0)
  14966    N DA,DIR, DIRUT,DIRO UT,DTOUT,D UOUT,RCMAX ,X,Y
  14967   "RTN","RCD PESP5",247 ,0)
  14968    S RCMAX=+ $$GET1^DIQ (344.61,"1 ,",.05)
  14969   "RTN","RCD PESP5",248 ,0)
  14970    S DIR("?" )="Enter t he maximum  amount th e CARC can  be auto-d ecreased b etween $1  and $"_RCM AX
  14971   "RTN","RCD PESP5",249 ,0)
  14972    S DIR(0)= "NA^1:"_RC MAX_":0"
  14973   "RTN","RCD PESP5",250 ,0)
  14974    S DIR("A" )="MAXIMUM  DOLLAR AM OUNT TO AU TO-DECREAS E PER CLAI M (1-"_RCM AX_"): "
  14975   "RTN","RCD PESP5",251 ,0)
  14976    ; END PRC A*4.5*326
  14977   "RTN","RCD PESP5",252 ,0)
  14978    D ^DIR
  14979   "RTN","RCD PESP5",253 ,0)
  14980    K DIR
  14981   "RTN","RCD PESP5",254 ,0)
  14982    I $G(DUOU T) S Y=-1
  14983   "RTN","RCD PESP5",255 ,0)
  14984    Q Y
  14985   "RTN","RCD PESP5",256 ,0)
  14986    ;
  14987   "RTN","RCD PESP5",257 ,0)
  14988    ;Get the  reason for  modificat ion
  14989   "RTN","RCD PESP5",258 ,0)
  14990   GETREASN(R CCARC) ;
  14991   "RTN","RCD PESP5",259 ,0)
  14992    N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT
  14993   "RTN","RCD PESP5",260 ,0)
  14994    S DIR("?" )="Enter r eason for  enabling/d isabling,  or changin g the Maxi mum Dollar  decrease  amount for  CARC "_RC CARC_" (3- 50 chars). "
  14995   "RTN","RCD PESP5",261 ,0)
  14996    S DIR(0)= "FA^3:50"
  14997   "RTN","RCD PESP5",262 ,0)
  14998    S DIR("A" )="COMMENT : "
  14999   "RTN","RCD PESP5",263 ,0)
  15000    S DIR("PR E")="S X=$ $TRIM^XLFS TR(X,""LR" ")" ; comm ent requir ed and sho uld be sig nificant
  15001   "RTN","RCD PESP5",264 ,0)
  15002    D ^DIR
  15003   "RTN","RCD PESP5",265 ,0)
  15004    K DIR
  15005   "RTN","RCD PESP5",266 ,0)
  15006    I $G(DUOU T) S Y=-1
  15007   "RTN","RCD PESP5",267 ,0)
  15008    Q Y
  15009   "RTN","RCD PESP5",268 ,0)
  15010    ;
  15011   "RTN","RCD PESP5",269 ,0)
  15012    ;Update t he databas e and audi t log
  15013   "RTN","RCD PESP5",270 ,0)
  15014   UPDDATA(RC CIEN,RCSTA T,RCAMT,RC RSN,PAID)  ; PAID add ed PRCA*4. 5*326
  15015   "RTN","RCD PESP5",271 ,0)
  15016    N DA,DR,D IE,DTOUT,X ,Y,DIC
  15017   "RTN","RCD PESP5",272 ,0)
  15018    ; replace d //// wit h /// in f ollowing 5  lines - P RCA*4.5*32 1
  15019   "RTN","RCD PESP5",273 ,0)
  15020    S DA=RCCI EN,(DIC,DI E)="^RCY(3 44.62,"
  15021   "RTN","RCD PESP5",274 ,0)
  15022    ; BEGIN -  PRCA*4.5* 326
  15023   "RTN","RCD PESP5",275 ,0)
  15024     ; Paid l ines
  15025   "RTN","RCD PESP5",276 ,0)
  15026    I PAID=1  D
  15027   "RTN","RCD PESP5",277 ,0)
  15028    .S DR=".0 2///"_RCST AT_";"
  15029   "RTN","RCD PESP5",278 ,0)
  15030    .S DR=DR_ ".05///"_$ $DT^XLFDT_ ";" ; PRCA *4.5*326
  15031   "RTN","RCD PESP5",279 ,0)
  15032    .S DR=DR_ ".04///"_D UZ_";"
  15033   "RTN","RCD PESP5",280 ,0)
  15034    .S DR=DR_ ".06///"_R CAMT_";"
  15035   "RTN","RCD PESP5",281 ,0)
  15036    .S DR=DR_ ".07///"_R CRSN_";"
  15037   "RTN","RCD PESP5",282 ,0)
  15038    ; No-pay  lines
  15039   "RTN","RCD PESP5",283 ,0)
  15040    I PAID=0  D
  15041   "RTN","RCD PESP5",284 ,0)
  15042    .S DR=".0 8///"_RCST AT_";"
  15043   "RTN","RCD PESP5",285 ,0)
  15044    .S DR=DR_ ".11///"_$ $DT^XLFDT_ ";"
  15045   "RTN","RCD PESP5",286 ,0)
  15046    .S DR=DR_ ".10///"_D UZ_";"
  15047   "RTN","RCD PESP5",287 ,0)
  15048    .S DR=DR_ ".12///"_R CAMT_";"
  15049   "RTN","RCD PESP5",288 ,0)
  15050    .S DR=DR_ ".13///"_R CRSN_";"
  15051   "RTN","RCD PESP5",289 ,0)
  15052    ; END - P RCA*4.5*32 6
  15053   "RTN","RCD PESP5",290 ,0)
  15054    ;
  15055   "RTN","RCD PESP5",291 ,0)
  15056    L +^RCY(3 44.62,RCCI EN):10 E   Q  ; PRCA* 4.5*326 ti meout cond ition adde d
  15057   "RTN","RCD PESP5",292 ,0)
  15058    D ^DIE
  15059   "RTN","RCD PESP5",293 ,0)
  15060    L -^RCY(3 44.62,RCCI EN)
  15061   "RTN","RCD PESP5",294 ,0)
  15062    Q  ; PRCA *4.5*326 -  return va lue remove
  15063   "RTN","RCD PESP5",295 ,0)
  15064    ;
  15065   "RTN","RCD PESP5",296 ,0)
  15066    ;Add new  entry to t he table
  15067   "RTN","RCD PESP5",297 ,0)
  15068   ADDDATA(RC CARC,RCAMT ,RCRSN,PAI D) ; PAID  added PRCA *4.5*326
  15069   "RTN","RCD PESP5",298 ,0)
  15070    N RCENTRY ,RCROOT,MS GROOT
  15071   "RTN","RCD PESP5",299 ,0)
  15072    ;
  15073   "RTN","RCD PESP5",300 ,0)
  15074    ; BEGIN -  PRCA*4.5* 326
  15075   "RTN","RCD PESP5",301 ,0)
  15076    ; set up  array for  paid lines
  15077   "RTN","RCD PESP5",302 ,0)
  15078    I PAID=1  D
  15079   "RTN","RCD PESP5",303 ,0)
  15080    .S RCENTR Y(344.62," +1,",.01)= RCCARC         ;CARC  Code
  15081   "RTN","RCD PESP5",304 ,0)
  15082    .S RCENTR Y(344.62," +1,",.02)= 1 ;Enabled  status
  15083   "RTN","RCD PESP5",305 ,0)
  15084    .S RCENTR Y(344.62," +1,",.03)= $$DT^XLFDT     ;Date  added PRCA *4.5*326
  15085   "RTN","RCD PESP5",306 ,0)
  15086    .S RCENTR Y(344.62," +1,",.04)= DUZ            ;User
  15087   "RTN","RCD PESP5",307 ,0)
  15088    .S RCENTR Y(344.62," +1,",.06)= RCAMT          ;Max a mount
  15089   "RTN","RCD PESP5",308 ,0)
  15090    .S RCENTR Y(344.62," +1,",.07)= RCRSN          ;Comme nt
  15091   "RTN","RCD PESP5",309 ,0)
  15092    ; set up  array for  no=pay lin es
  15093   "RTN","RCD PESP5",310 ,0)
  15094    I PAID=0  D
  15095   "RTN","RCD PESP5",311 ,0)
  15096    .S RCENTR Y(344.62," +1,",.01)= RCCARC         ;CARC  Code
  15097   "RTN","RCD PESP5",312 ,0)
  15098    .S RCENTR Y(344.62," +1,",.08)= 1              ;Enabl ed status
  15099   "RTN","RCD PESP5",313 ,0)
  15100    .S RCENTR Y(344.62," +1,",.09)= $$DT^XLFDT     ;Date/ Time added
  15101   "RTN","RCD PESP5",314 ,0)
  15102    .S RCENTR Y(344.62," +1,",.10)= DUZ            ;User
  15103   "RTN","RCD PESP5",315 ,0)
  15104    .S RCENTR Y(344.62," +1,",.12)= RCAMT          ;Max a mount
  15105   "RTN","RCD PESP5",316 ,0)
  15106    .S RCENTR Y(344.62," +1,",.13)= RCRSN          ;Comme nt
  15107   "RTN","RCD PESP5",317 ,0)
  15108    ; END - P RCA*4.5*32 6
  15109   "RTN","RCD PESP5",318 ,0)
  15110    ;file ent ry
  15111   "RTN","RCD PESP5",319 ,0)
  15112    D UPDATE^ DIE(,"RCEN TRY","RCRO OT","MSGRO OT")
  15113   "RTN","RCD PESP5",320 ,0)
  15114    Q
  15115   "RTN","RCD PESP5",321 ,0)
  15116    ;
  15117   "RTN","RCD PESP5",322 ,0)
  15118   AUDIT() ;
  15119   "RTN","RCD PESP5",323 ,0)
  15120    ;
  15121   "RTN","RCD PESP5",324 ,0)
  15122    N EMEDANS ,EOLDMED,E OLDRX,ERXA NS,MEDANS, OLDMED,OLD RX,RXANS,T RICAA ; PR CA*4.5*321
  15123   "RTN","RCD PESP5",325 ,0)
  15124    ;
  15125   "RTN","RCD PESP5",326 ,0)
  15126    ; Get exi sting answ ers for Me dical and  Pharmacy p aper bills
  15127   "RTN","RCD PESP5",327 ,0)
  15128    S OLDMED= $$GET1^DIQ (342,"1,", 7.05,"I")
  15129   "RTN","RCD PESP5",328 ,0)
  15130    S OLDRX=$ $GET1^DIQ( 342,"1,",7 .06,"I")
  15131   "RTN","RCD PESP5",329 ,0)
  15132    ;
  15133   "RTN","RCD PESP5",330 ,0)
  15134    ; Get exi sting (#7. 09) AUTO-A UDIT TRICA RE EDI BIL LS [9S]
  15135   "RTN","RCD PESP5",331 ,0)
  15136    S TRICAA( "old")=$$G ET1^DIQ(34 2,"1,",7.0 9,"I")
  15137   "RTN","RCD PESP5",332 ,0)
  15138    ;
  15139   "RTN","RCD PESP5",333 ,0)
  15140    ; Get exi sting answ ers for Me dical and  Pharmacy E DI (electr onic) bill s ; PRCA*4 .5*321
  15141   "RTN","RCD PESP5",334 ,0)
  15142    S EOLDMED =$$GET1^DI Q(342,"1," ,7.07,"I")  ; PRCA*4. 5*321
  15143   "RTN","RCD PESP5",335 ,0)
  15144    S EOLDRX= $$GET1^DIQ (342,"1,", 7.08,"I")  ; PRCA*4.5 *321
  15145   "RTN","RCD PESP5",336 ,0)
  15146    ;
  15147   "RTN","RCD PESP5",337 ,0)
  15148    ; Get Med ical paper  bills
  15149   "RTN","RCD PESP5",338 ,0)
  15150    S MEDANS= $$GETAUDIT (1)
  15151   "RTN","RCD PESP5",339 ,0)
  15152    Q:MEDANS= -1 1
  15153   "RTN","RCD PESP5",340 ,0)
  15154    ; File Me dical pape r bills
  15155   "RTN","RCD PESP5",341 ,0)
  15156    I MEDANS' =OLDMED D
  15157   "RTN","RCD PESP5",342 ,0)
  15158    . N RCAUD VAL
  15159   "RTN","RCD PESP5",343 ,0)
  15160    . D FILEA NS(7.05,ME DANS)
  15161   "RTN","RCD PESP5",344 ,0)
  15162    . ; FILE  NUMBER^FIE LD NUMBER^ IEN^NEW VA LUE^OLD VA LUE^COMMEN T
  15163   "RTN","RCD PESP5",345 ,0)
  15164    . S RCAUD VAL(1)="34 2^7.05^1^" _MEDANS_U_ OLDMED_U_" Updating t he Medical  Auto-Audi t of paper  bills"
  15165   "RTN","RCD PESP5",346 ,0)
  15166    . D AUDIT ^RCDPESP(. RCAUDVAL)
  15167   "RTN","RCD PESP5",347 ,0)
  15168    ;
  15169   "RTN","RCD PESP5",348 ,0)
  15170    ; Get Pha rmacy pape r bills
  15171   "RTN","RCD PESP5",349 ,0)
  15172    S RXANS=$ $GETAUDIT( 2)
  15173   "RTN","RCD PESP5",350 ,0)
  15174    Q:RXANS=- 1 1
  15175   "RTN","RCD PESP5",351 ,0)
  15176    ;
  15177   "RTN","RCD PESP5",352 ,0)
  15178    ; File Ph armacy pap er bills
  15179   "RTN","RCD PESP5",353 ,0)
  15180    I RXANS'= OLDRX D
  15181   "RTN","RCD PESP5",354 ,0)
  15182    . N RCAUD VAL
  15183   "RTN","RCD PESP5",355 ,0)
  15184    . D FILEA NS(7.06,RX ANS)
  15185   "RTN","RCD PESP5",356 ,0)
  15186    . S RCAUD VAL(1)="34 2^7.06^1^" _RXANS_U_O LDRX_U_"Up dating the  Pharmacy  Auto-Audit  of paper  bills"
  15187   "RTN","RCD PESP5",357 ,0)
  15188    . D AUDIT ^RCDPESP(. RCAUDVAL)
  15189   "RTN","RCD PESP5",358 ,0)
  15190    ;
  15191   "RTN","RCD PESP5",359 ,0)
  15192    ; BEGIN P RCA*4.5*32 1
  15193   "RTN","RCD PESP5",360 ,0)
  15194    ; Get Med ical elect ronic bill s
  15195   "RTN","RCD PESP5",361 ,0)
  15196    S EMEDANS =$$GETAUDI T(3)
  15197   "RTN","RCD PESP5",362 ,0)
  15198    Q:EMEDANS =-1 1
  15199   "RTN","RCD PESP5",363 ,0)
  15200    ; File Me dical elec tronic bil ls
  15201   "RTN","RCD PESP5",364 ,0)
  15202    I EMEDANS '=EOLDMED  D
  15203   "RTN","RCD PESP5",365 ,0)
  15204    . N RCAUD VAL
  15205   "RTN","RCD PESP5",366 ,0)
  15206    . D FILEA NS(7.07,EM EDANS)
  15207   "RTN","RCD PESP5",367 ,0)
  15208    . ; FILE  NUMBER^FIE LD NUMBER^ IEN^NEW VA LUE^OLD VA LUE^COMMEN T
  15209   "RTN","RCD PESP5",368 ,0)
  15210    . S RCAUD VAL(1)="34 2^7.07^1^" _EMEDANS_U _EOLDMED_U _"Updating  the Medic al Auto-Au dit of ele ctronic bi lls"
  15211   "RTN","RCD PESP5",369 ,0)
  15212    . D AUDIT ^RCDPESP(. RCAUDVAL)
  15213   "RTN","RCD PESP5",370 ,0)
  15214    ;
  15215   "RTN","RCD PESP5",371 ,0)
  15216    ; Get Pha rmacy elec tronic bil ls
  15217   "RTN","RCD PESP5",372 ,0)
  15218    S ERXANS= $$GETAUDIT (4)
  15219   "RTN","RCD PESP5",373 ,0)
  15220    Q:ERXANS= -1 1
  15221   "RTN","RCD PESP5",374 ,0)
  15222    ;
  15223   "RTN","RCD PESP5",375 ,0)
  15224    ; File Ph armacy ele ctronic bi lls
  15225   "RTN","RCD PESP5",376 ,0)
  15226    I ERXANS' =EOLDRX D
  15227   "RTN","RCD PESP5",377 ,0)
  15228    . N RCAUD VAL
  15229   "RTN","RCD PESP5",378 ,0)
  15230    . D FILEA NS(7.08,ER XANS)
  15231   "RTN","RCD PESP5",379 ,0)
  15232    . S RCAUD VAL(1)="34 2^7.08^1^" _ERXANS_U_ EOLDRX_U_" Updating t he Pharmac y Auto-Aud it of elec tronic bil ls"
  15233   "RTN","RCD PESP5",380 ,0)
  15234    . D AUDIT ^RCDPESP(. RCAUDVAL)
  15235   "RTN","RCD PESP5",381 ,0)
  15236    ; END PRC A*4.5*321
  15237   "RTN","RCD PESP5",382 ,0)
  15238    ;
  15239   "RTN","RCD PESP5",383 ,0)
  15240    S TRICAA( "new")=$$G ETAUDIT(5)
  15241   "RTN","RCD PESP5",384 ,0)
  15242    Q:TRICAA( "new")=-1  1
  15243   "RTN","RCD PESP5",385 ,0)
  15244    ; File (# 7.09) AUTO -AUDIT TRI CARE EDI B ILLS [9S]  - PRCA*4.5 *332
  15245   "RTN","RCD PESP5",386 ,0)
  15246    I TRICAA( "new")'=TR ICAA("old" ) D
  15247   "RTN","RCD PESP5",387 ,0)
  15248    . N RCAUD VAL
  15249   "RTN","RCD PESP5",388 ,0)
  15250    . D FILEA NS(7.09,TR ICAA("new" ))
  15251   "RTN","RCD PESP5",389 ,0)
  15252    . ; FILE  NUMBER^FIE LD NUMBER^ IEN^NEW VA LUE^OLD VA LUE^COMMEN T
  15253   "RTN","RCD PESP5",390 ,0)
  15254    . S RCAUD VAL(1)="34 2^7.09^1^" _TRICAA("n ew")_U_TRI CAA("old") _U_"Updati ng the Aut o-Audit of  Tricare b ills"
  15255   "RTN","RCD PESP5",391 ,0)
  15256    . D AUDIT ^RCDPESP(. RCAUDVAL)
  15257   "RTN","RCD PESP5",392 ,0)
  15258    ;
  15259   "RTN","RCD PESP5",393 ,0)
  15260    Q 0
  15261   "RTN","RCD PESP5",394 ,0)
  15262    ;
  15263   "RTN","RCD PESP5",395 ,0)
  15264    ;Retrieve  the param eter for t he bill ty pe
  15265   "RTN","RCD PESP5",396 ,0)
  15266   GETAUDIT(F LAG) ;
  15267   "RTN","RCD PESP5",397 ,0)
  15268    ; BEGIN P RCA*4.5*32 1
  15269   "RTN","RCD PESP5",398 ,0)
  15270    ;FLAG - W hat audit  type (1=Me d Paper, 2 =RX Paper,  3=Med EDI , 4=Rx EDI , 5=Tricar e)
  15271   "RTN","RCD PESP5",399 ,0)
  15272    Q:'$G(FLA G) -1
  15273   "RTN","RCD PESP5",400 ,0)
  15274    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,FLDNO,RC ANS,TYPL,T YPU,X,Y
  15275   "RTN","RCD PESP5",401 ,0)
  15276    S TYPL=$S (FLAG>2:"e lectronic" ,1:"paper" )
  15277   "RTN","RCD PESP5",402 ,0)
  15278    S TYPU=$S (FLAG>2:"E LECTRONIC" ,1:"PAPER" )
  15279   "RTN","RCD PESP5",403 ,0)
  15280    S FLDNO=$ S(FLAG=1:7 .05,FLAG=2 :7.06,FLAG =3:7.07,FL AG=4:7.08, FLAG=5:7.0 9,1:0)
  15281   "RTN","RCD PESP5",404 ,0)
  15282    Q:'FLDNO  -1
  15283   "RTN","RCD PESP5",405 ,0)
  15284    ;
  15285   "RTN","RCD PESP5",406 ,0)
  15286    ; Prompt  for Medica l Auto-aud it
  15287   "RTN","RCD PESP5",407 ,0)
  15288    D:$G(FLAG )#2=1
  15289   "RTN","RCD PESP5",408 ,0)
  15290    . S DIR(" A")="ENABL E AUTO-AUD IT FOR MED ICAL "_TYP U_" BILLS  (Y/N): "
  15291   "RTN","RCD PESP5",409 ,0)
  15292    . S DIR(" ?",1)="All ow a site  to automat ically aud it their M edical "_T YPL_" Bill s"
  15293   "RTN","RCD PESP5",410 ,0)
  15294    . S DIR(" ?",2)="dur ing the AR  Nightly P rocess."
  15295   "RTN","RCD PESP5",411 ,0)
  15296    . S DIR(" ?",3)=" "
  15297   "RTN","RCD PESP5",412 ,0)
  15298    . S RCANS =$$GET1^DI Q(342,"1," ,FLDNO)
  15299   "RTN","RCD PESP5",413 ,0)
  15300    ;
  15301   "RTN","RCD PESP5",414 ,0)
  15302    ; Prompt  for Pharma cy Auto-au dit
  15303   "RTN","RCD PESP5",415 ,0)
  15304    D:$G(FLAG )#2=0
  15305   "RTN","RCD PESP5",416 ,0)
  15306    . S DIR(" A")="ENABL E AUTO-AUD IT FOR PHA RMACY "_TY PU_" BILLS  (Y/N): "
  15307   "RTN","RCD PESP5",417 ,0)
  15308    . S DIR(" ?",1)="All ow a site  to automat ically aud it their P harmacy "_ TYPL_" Bil ls"
  15309   "RTN","RCD PESP5",418 ,0)
  15310    . S DIR(" ?",2)="dur ing the AR  Nightly P rocess."
  15311   "RTN","RCD PESP5",419 ,0)
  15312    . S DIR(" ?",3)=" "
  15313   "RTN","RCD PESP5",420 ,0)
  15314    . S RCANS =$$GET1^DI Q(342,"1," ,FLDNO)
  15315   "RTN","RCD PESP5",421 ,0)
  15316    ; END PRC A*4.5*321
  15317   "RTN","RCD PESP5",422 ,0)
  15318    ;
  15319   "RTN","RCD PESP5",423 ,0)
  15320    ; Prompt  for Tricar e Auto-aud it PRCA*4. 5*332
  15321   "RTN","RCD PESP5",424 ,0)
  15322    D:$G(FLAG )=5
  15323   "RTN","RCD PESP5",425 ,0)
  15324    . S DIR(" A")="ENABL E AUTO-AUD IT FOR TRI CARE BILLS  (Y/N): "
  15325   "RTN","RCD PESP5",426 ,0)
  15326    . S DIR(" ?",1)="All ow a site  to automat ically aud it their T ricare Bil ls"
  15327   "RTN","RCD PESP5",427 ,0)
  15328    . S DIR(" ?",2)="dur ing the AR  Nightly P rocess."
  15329   "RTN","RCD PESP5",428 ,0)
  15330    . S DIR(" ?",3)=" "
  15331   "RTN","RCD PESP5",429 ,0)
  15332    . S RCANS =$$GET1^DI Q(342,"1," ,7.09)
  15333   "RTN","RCD PESP5",430 ,0)
  15334    ;
  15335   "RTN","RCD PESP5",431 ,0)
  15336    S DIR(0)= "YAO"
  15337   "RTN","RCD PESP5",432 ,0)
  15338    S DIR("?" )="Enter Y es or No t o select a utomatic p rocessing  of "_TYPL_ " bills."  ; PRCA*4.5 *321
  15339   "RTN","RCD PESP5",433 ,0)
  15340    S DIR("B" )=$S($G(RC ANS)'="":R CANS,1:"No ")
  15341   "RTN","RCD PESP5",434 ,0)
  15342    D ^DIR K  DIR
  15343   "RTN","RCD PESP5",435 ,0)
  15344    I Y="" Q  ""
  15345   "RTN","RCD PESP5",436 ,0)
  15346    I $D(DTOU T)!$D(DUOU T)!(Y="")   Q -1
  15347   "RTN","RCD PESP5",437 ,0)
  15348    Q Y
  15349   "RTN","RCD PESP5",438 ,0)
  15350    ;
  15351   "RTN","RCD PESP5",439 ,0)
  15352    ;File the  answer
  15353   "RTN","RCD PESP5",440 ,0)
  15354   FILEANS(FI ELD,ANS) ;
  15355   "RTN","RCD PESP5",441 ,0)
  15356    ;
  15357   "RTN","RCD PESP5",442 ,0)
  15358    N DR,DIE, DA,DTOUT,D IDEL,X,Y
  15359   "RTN","RCD PESP5",443 ,0)
  15360    ;
  15361   "RTN","RCD PESP5",444 ,0)
  15362    ;Update T ransaction
  15363   "RTN","RCD PESP5",445 ,0)
  15364    S DR=FIEL D_"///"_AN S            ;Origina l Confirma tion #
  15365   "RTN","RCD PESP5",446 ,0)
  15366    S DIE="^R C(342,"
  15367   "RTN","RCD PESP5",447 ,0)
  15368    S DA=1
  15369   "RTN","RCD PESP5",448 ,0)
  15370    D ^DIE
  15371   "RTN","RCD PESP5",449 ,0)
  15372    ;
  15373   "RTN","RCD PESP5",450 ,0)
  15374    Q
  15375   "RTN","RCD PESP5",451 ,0)
  15376    ;
  15377   "RTN","RCD PESP5",452 ,0)
  15378    ;BEGIN PR CA*4.5*326
  15379   "RTN","RCD PESP5",453 ,0)
  15380   CARCDSP(RC MAX) ; EP  ^RCDPESP7
  15381   "RTN","RCD PESP5",454 ,0)
  15382    N RCCHECK
  15383   "RTN","RCD PESP5",455 ,0)
  15384    ;
  15385   "RTN","RCD PESP5",456 ,0)
  15386    ; Check f or CARCs t hat will b e reset to  the new m aximum and  display
  15387   "RTN","RCD PESP5",457 ,0)
  15388    S RCCHECK =0
  15389   "RTN","RCD PESP5",458 ,0)
  15390    ; Paid li ne CARCs
  15391   "RTN","RCD PESP5",459 ,0)
  15392    D CHECK(R CMAX,1,1,. RCCHECK)
  15393   "RTN","RCD PESP5",460 ,0)
  15394    ; No-pay  line CARCs
  15395   "RTN","RCD PESP5",461 ,0)
  15396    D CHECK(R CMAX,0,1,. RCCHECK)
  15397   "RTN","RCD PESP5",462 ,0)
  15398    ;
  15399   "RTN","RCD PESP5",463 ,0)
  15400    ; Finish  if none fo und
  15401   "RTN","RCD PESP5",464 ,0)
  15402    Q:'RCCHEC K 1
  15403   "RTN","RCD PESP5",465 ,0)
  15404    ;
  15405   "RTN","RCD PESP5",466 ,0)
  15406    ; Ask if  OK to proc eed and re duce these  CARCs
  15407   "RTN","RCD PESP5",467 ,0)
  15408    N DIR,DTO UT,DUOUT
  15409   "RTN","RCD PESP5",468 ,0)
  15410    S DIR(0)= "YA"
  15411   "RTN","RCD PESP5",469 ,0)
  15412    S DIR("A" )="Do you  want to co ntinue (Y/ N)? "
  15413   "RTN","RCD PESP5",470 ,0)
  15414    W ! D ^DI R
  15415   "RTN","RCD PESP5",471 ,0)
  15416    ; Abort
  15417   "RTN","RCD PESP5",472 ,0)
  15418    I $D(DUOU T)!$D(DTOU T) Q "QUIT "
  15419   "RTN","RCD PESP5",473 ,0)
  15420    ; Go back  and re-en ter maximu m amount
  15421   "RTN","RCD PESP5",474 ,0)
  15422    I 'Y Q 0
  15423   "RTN","RCD PESP5",475 ,0)
  15424    ;
  15425   "RTN","RCD PESP5",476 ,0)
  15426    ; Update  the CARCs  previously  displayed
  15427   "RTN","RCD PESP5",477 ,0)
  15428    S RCCHECK =0
  15429   "RTN","RCD PESP5",478 ,0)
  15430    ; Update  paid line  CARCs
  15431   "RTN","RCD PESP5",479 ,0)
  15432    D CHECK(R CMAX,1,0,. RCCHECK)
  15433   "RTN","RCD PESP5",480 ,0)
  15434    ; Update  no-pay lin e CARCs
  15435   "RTN","RCD PESP5",481 ,0)
  15436    D CHECK(R CMAX,0,0,. RCCHECK)
  15437   "RTN","RCD PESP5",482 ,0)
  15438    Q 1
  15439   "RTN","RCD PESP5",483 ,0)
  15440    ;
  15441   "RTN","RCD PESP5",484 ,0)
  15442   CHECK(RCMA X,RCPAID,R CDSP,RCCNT ) ;Display /Reset any  CARC maxi mum values  which exc eed upper  limit
  15443   "RTN","RCD PESP5",485 ,0)
  15444    ; Input   - RCMAX =  Maximum al lowed $ de crease per  claim (fr om #344.61 , #.05)
  15445   "RTN","RCD PESP5",486 ,0)
  15446    ;           RCPAID -  1 = CARCs  for paid  claims, 0  = CARC's f or NO-PAY  claims
  15447   "RTN","RCD PESP5",487 ,0)
  15448    ;           RCDSP -  1 = displa y only, 0  = update o nly
  15449   "RTN","RCD PESP5",488 ,0)
  15450    ;           RCCNT =  cummulativ e count of  pay and n o-pay reco rds found
  15451   "RTN","RCD PESP5",489 ,0)
  15452    ; Output  - Updates  #344.62 -  RCDPE CARC -RARC AUTO  DEC
  15453   "RTN","RCD PESP5",490 ,0)
  15454    ;           Updates  #344.7 - R CDPE PARAM ETER AUDIT
  15455   "RTN","RCD PESP5",491 ,0)
  15456    ;
  15457   "RTN","RCD PESP5",492 ,0)
  15458    N RCACT,R CAMT,RCARR ,RCCODE,RC CT,RCDESC, RCFLD,RCFL DA,RCI,RCI NACT,RCSTA T,RCSUB,RC TXT
  15459   "RTN","RCD PESP5",493 ,0)
  15460    ; Max Amo unt field
  15461   "RTN","RCD PESP5",494 ,0)
  15462    S RCFLD=$ S(RCPAID:. 06,1:.12)
  15463   "RTN","RCD PESP5",495 ,0)
  15464    ; Auto-de crease Y/N  field
  15465   "RTN","RCD PESP5",496 ,0)
  15466    S RCFLDA= $S(RCPAID: .02,1:.08)
  15467   "RTN","RCD PESP5",497 ,0)
  15468    ; Search  for entrie s that nee d reducing
  15469   "RTN","RCD PESP5",498 ,0)
  15470    S RCI=0,R CARR=0
  15471   "RTN","RCD PESP5",499 ,0)
  15472    F  S RCI= $O(^RCY(34 4.62,RCI))  Q:'RCI  D
  15473   "RTN","RCD PESP5",500 ,0)
  15474    . ; Check  if this i s an activ e code
  15475   "RTN","RCD PESP5",501 ,0)
  15476    . S RCACT =$$GET1^DI Q(344.62,R CI_",",RCF LDA,"I")
  15477   "RTN","RCD PESP5",502 ,0)
  15478    . Q:'RCAC T
  15479   "RTN","RCD PESP5",503 ,0)
  15480    . ; Maxim um amount  for CARC
  15481   "RTN","RCD PESP5",504 ,0)
  15482    . S RCAMT =$$GET1^DI Q(344.62,R CI_",",RCF LD)
  15483   "RTN","RCD PESP5",505 ,0)
  15484    . ; Check  if limit  exceeded
  15485   "RTN","RCD PESP5",506 ,0)
  15486    . Q:RCAMT '>RCMAX
  15487   "RTN","RCD PESP5",507 ,0)
  15488    . ; Save  CARC  for  reset and/ or display
  15489   "RTN","RCD PESP5",508 ,0)
  15490    . S RCARR =RCARR+1,R CCNT=RCCNT +1
  15491   "RTN","RCD PESP5",509 ,0)
  15492    . S RCARR (RCARR)=RC I_U_RCAMT
  15493   "RTN","RCD PESP5",510 ,0)
  15494    ;
  15495   "RTN","RCD PESP5",511 ,0)
  15496    Q:RCARR=0
  15497   "RTN","RCD PESP5",512 ,0)
  15498    ;
  15499   "RTN","RCD PESP5",513 ,0)
  15500    I RCDSP=1  D
  15501   "RTN","RCD PESP5",514 ,0)
  15502    .S RCTXT= $S('RCPAID :"NO-PAY " ,1:"")
  15503   "RTN","RCD PESP5",515 ,0)
  15504    .W !!,"Wa rning:"
  15505   "RTN","RCD PESP5",516 ,0)
  15506    .W !," Th e followin g "_RCTXT_ "CARC code s' max. am t will be  changed to  the new l imit $"_RC MAX
  15507   "RTN","RCD PESP5",517 ,0)
  15508    S RCSUB=0
  15509   "RTN","RCD PESP5",518 ,0)
  15510    F  S RCSU B=$O(RCARR (RCSUB)) Q :'RCSUB  D
  15511   "RTN","RCD PESP5",519 ,0)
  15512    . S RCI=$ P(RCARR(RC SUB),U)
  15513   "RTN","RCD PESP5",520 ,0)
  15514    . S RCAMT =$P(RCARR( RCSUB),U,2 )
  15515   "RTN","RCD PESP5",521 ,0)
  15516    . ; Displ ay line
  15517   "RTN","RCD PESP5",522 ,0)
  15518    . I RCDSP  D
  15519   "RTN","RCD PESP5",523 ,0)
  15520    . . S RCC ODE=$$GET1 ^DIQ(344.6 2,RCI_",", .01)
  15521   "RTN","RCD PESP5",524 ,0)
  15522    . . S RCC IEN=$O(^RC (345,"B",R CCODE,""))
  15523   "RTN","RCD PESP5",525 ,0)
  15524    . . S RCD ESC=$G(^RC (345,RCCIE N,1,1,0))
  15525   "RTN","RCD PESP5",526 ,0)
  15526    . . I $L( RCDESC)>50  S RCDESC= $E(RCDESC, 1,50)_" .. ."
  15527   "RTN","RCD PESP5",527 ,0)
  15528    . . W !,? 3,RCCODE,? 9,$E(RCDES C,1,55),?6 3,$J(RCAMT ,10,0)
  15529   "RTN","RCD PESP5",528 ,0)
  15530    . ; Reset  CARC to t op limit
  15531   "RTN","RCD PESP5",529 ,0)
  15532    . I 'RCDS P D
  15533   "RTN","RCD PESP5",530 ,0)
  15534    . . N RCA UDARY,RCST AT,RCTXT
  15535   "RTN","RCD PESP5",531 ,0)
  15536    . . S RCS TAT=$$GET1 ^DIQ(344.6 2,RCI_",", .02) ; Lea ve status  unchanged
  15537   "RTN","RCD PESP5",532 ,0)
  15538    . . S RCT XT="Max. A mt reduced  to top li mit"
  15539   "RTN","RCD PESP5",533 ,0)
  15540    . . ; Upd ate #344.6 2 - RCDPE  CARC-RARC  AUTO DEC
  15541   "RTN","RCD PESP5",534 ,0)
  15542    . . D UPD DATA(RCI,R CSTAT,RCMA X,RCTXT,RC PAID)
  15543   "RTN","RCD PESP5",535 ,0)
  15544    . . S RCT XT="Update d automati cally - ov er maximum  allowed"
  15545   "RTN","RCD PESP5",536 ,0)
  15546    . . ; Upd ate #344.7  - RCDPE P ARAMETER A UDIT
  15547   "RTN","RCD PESP5",537 ,0)
  15548    . . S RCA UDARY(1)=" 344.62^"_R CFLD_"^"_R CI_"^"_RCM AX_"^"_RCA MT_"^"_RCT XT
  15549   "RTN","RCD PESP5",538 ,0)
  15550    . . D AUD IT^RCDPESP (.RCAUDARY )
  15551   "RTN","RCD PESP5",539 ,0)
  15552    Q
  15553   "RTN","RCD PESP5",540 ,0)
  15554    ; END PRC A*4.5*326
  15555   "RTN","RCD PESP6")
  15556   0^8^B65240 726
  15557   "RTN","RCD PESP6",1,0 )
  15558   RCDPESP6 ; AITC/CJE -  ePayment  Lockbox Si te Paramet ers - Noti fy Changes ;27 Sept 2 018 15:56: 10
  15559   "RTN","RCD PESP6",2,0 )
  15560    ;;4.5;Acc ounts Rece ivable;**3 26,332**;; Build 34
  15561   "RTN","RCD PESP6",3,0 )
  15562    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  15563   "RTN","RCD PESP6",4,0 )
  15564    ;
  15565   "RTN","RCD PESP6",5,0 )
  15566    Q
  15567   "RTN","RCD PESP6",6,0 )
  15568   EN ; On en try into p arameter e dit, save  a snapshot  of the fi les
  15569   "RTN","RCD PESP6",7,0 )
  15570    ; Input:  None
  15571   "RTN","RCD PESP6",8,0 )
  15572    ; Output:  ^TMP("RCD PESP6",$J)  created b y merging  in files 3 44.6, 344. 61 and 344 .62
  15573   "RTN","RCD PESP6",9,0 )
  15574    K ^TMP("R CDPESP6",$ J)
  15575   "RTN","RCD PESP6",10, 0)
  15576    M ^TMP("R CDPESP6",$ J,344.6)=^ RCY(344.6)    ; Save  payer excl usions
  15577   "RTN","RCD PESP6",11, 0)
  15578    M ^TMP("R CDPESP6",$ J,344.61)= ^RCY(344.6 1) ; Save  parameters
  15579   "RTN","RCD PESP6",12, 0)
  15580    M ^TMP("R CDPESP6",$ J,344.62)= ^RCY(344.6 2) ; Save  CARC/RARC  auto dec
  15581   "RTN","RCD PESP6",13, 0)
  15582    Q
  15583   "RTN","RCD PESP6",14, 0)
  15584   EXIT ; On  exit from  parameter  edit, comp are snapsh ot with li ve files.
  15585   "RTN","RCD PESP6",15, 0)
  15586    ; Send a  mail messa ge if any  designated  items hav e changed.
  15587   "RTN","RCD PESP6",16, 0)
  15588    ; Input:  ^TMP("RCDP ESP6",$J)  created ab ove by mer ging in fi les 344.6,  344.61 an d 344.62
  15589   "RTN","RCD PESP6",17, 0)
  15590    ; Output:  Mail mess age (if an y paramete rs have ch anged)
  15591   "RTN","RCD PESP6",18, 0)
  15592    ;
  15593   "RTN","RCD PESP6",19, 0)
  15594    N CHANGES ,CHGCNT,LI NES,RCMSGT XT,RCSITE, RCSUBJ,XMI NSTR,XMTO
  15595   "RTN","RCD PESP6",20, 0)
  15596    ;
  15597   "RTN","RCD PESP6",21, 0)
  15598    S CHGCNT= 0
  15599   "RTN","RCD PESP6",22, 0)
  15600    S CHGCNT= $$CHKCHNG( .RCMSGTXT)  ; Check f or any cha nges in pa rameters
  15601   "RTN","RCD PESP6",23, 0)
  15602    ;
  15603   "RTN","RCD PESP6",24, 0)
  15604    I 'CHGCNT  Q  ; No c hanges mad e so don't  send mess age
  15605   "RTN","RCD PESP6",25, 0)
  15606    ;
  15607   "RTN","RCD PESP6",26, 0)
  15608    S RCSITE= $$SITE^VAS ITE()
  15609   "RTN","RCD PESP6",27, 0)
  15610    S RCSUBJ= $E("ePayme nts EDI Lo ckbox Para meters cha nged "_$P( RCSITE,U,2 ),1,65)
  15611   "RTN","RCD PESP6",28, 0)
  15612    D HEADER( .RCMSGTXT, RCSITE)
  15613   "RTN","RCD PESP6",29, 0)
  15614    ;
  15615   "RTN","RCD PESP6",30, 0)
  15616    S XMINSTR ("FROM")=" POSTMASTER "
  15617   "RTN","RCD PESP6",31, 0)
  15618    ;
  15619   "RTN","RCD PESP6",32, 0)
  15620    S XMTO(DU Z)="",XMTO ("G.RCDPE  AUDIT")=""
  15621   "RTN","RCD PESP6",33, 0)
  15622    ;
  15623   "RTN","RCD PESP6",34, 0)
  15624    K ^TMP("X MERR",$J)
  15625   "RTN","RCD PESP6",35, 0)
  15626    D SENDMSG ^XMXAPI(DU Z,RCSUBJ," RCMSGTXT", .XMTO,.XMI NSTR)
  15627   "RTN","RCD PESP6",36, 0)
  15628    ;
  15629   "RTN","RCD PESP6",37, 0)
  15630    I $D(^TMP ("XMERR",$ J)) D
  15631   "RTN","RCD PESP6",38, 0)
  15632    . N G
  15633   "RTN","RCD PESP6",39, 0)
  15634    . D MES^X PDUTL("Mai lMan retur ned an err or.")
  15635   "RTN","RCD PESP6",40, 0)
  15636    . D MES^X PDUTL("The  error tex t is:")
  15637   "RTN","RCD PESP6",41, 0)
  15638    . S G=$NA (^TMP("XME RR",$J))
  15639   "RTN","RCD PESP6",42, 0)
  15640    . F  S G= $Q(@G) Q:G =""  Q:$QS (G,2)'=$J   D MES^XPD UTL("  "_$ C(34)_@G_$ C(34))
  15641   "RTN","RCD PESP6",43, 0)
  15642    . D MES^X PDUTL(" *  End of Err or Text *" )
  15643   "RTN","RCD PESP6",44, 0)
  15644    . K ^TMP( "XMERR",$J )
  15645   "RTN","RCD PESP6",45, 0)
  15646    ;
  15647   "RTN","RCD PESP6",46, 0)
  15648    K ^TMP("R CDPESP6",$ J) ; Clean  up saved  files
  15649   "RTN","RCD PESP6",47, 0)
  15650    Q
  15651   "RTN","RCD PESP6",48, 0)
  15652    ;
  15653   "RTN","RCD PESP6",49, 0)
  15654   HEADER(MSG TXT,RCSITE )  ; Add H eader Line s to the m ail messag e text
  15655   "RTN","RCD PESP6",50, 0)
  15656    ; Input:  None
  15657   "RTN","RCD PESP6",51, 0)
  15658    ; Output:  Array MSG TXT passed  by refere nce
  15659   "RTN","RCD PESP6",52, 0)
  15660    ;
  15661   "RTN","RCD PESP6",53, 0)
  15662    ; limit s ubject to  65 chars.
  15663   "RTN","RCD PESP6",54, 0)
  15664    S MSGTXT( 1)=" "
  15665   "RTN","RCD PESP6",55, 0)
  15666    S MSGTXT( 2)="         Site: "_ $P(RCSITE, U,2)
  15667   "RTN","RCD PESP6",56, 0)
  15668    S MSGTXT( 3)="    St ation # "_ $P(RCSITE, U,3)
  15669   "RTN","RCD PESP6",57, 0)
  15670    S MSGTXT( 4)="       Domain: "_ $G(^XMB("N ETNAME"))
  15671   "RTN","RCD PESP6",58, 0)
  15672    S MSGTXT( 5)="   Dat e/Time: "_ $$FMTE^XLF DT($$NOW^X LFDT,"1ZPM ")
  15673   "RTN","RCD PESP6",59, 0)
  15674    S MSGTXT( 6)="         User: "_ $P($G(^VA( 200,DUZ,0) ),U)
  15675   "RTN","RCD PESP6",60, 0)
  15676    S MSGTXT( 7)=" "
  15677   "RTN","RCD PESP6",61, 0)
  15678    S MSGTXT( 8)=" The f ollowing E DI Lockbox  Site Para meters wer e changed:  "
  15679   "RTN","RCD PESP6",62, 0)
  15680    S MSGTXT( 9)=" "
  15681   "RTN","RCD PESP6",63, 0)
  15682    S MSGTXT( 10)=$J("", 50)_$J("OL D VALUE",1 0)_"  "_$J ("NEW VALU E",10)
  15683   "RTN","RCD PESP6",64, 0)
  15684    Q
  15685   "RTN","RCD PESP6",65, 0)
  15686   CHKCHNG(LI NE) ; Chec k for chan ges in EDI  Lockbox s ite parame ters
  15687   "RTN","RCD PESP6",66, 0)
  15688    ; Input:  ^TMP("RCDP ESP6",$J)  - Copy of  file 344.6 , 344.61 a nd 344.62  taken on e ntry
  15689   "RTN","RCD PESP6",67, 0)
  15690    ; Output:  LINE - Ch ange lines  to add to  the mail  message. P assed by r eference.
  15691   "RTN","RCD PESP6",68, 0)
  15692    ; Return:  COUNT of  the number  of change s. 0 if no  changes w ere made.
  15693   "RTN","RCD PESP6",69, 0)
  15694    N COUNT,D OTS,HEAD,I EN,J,RCDET ,REC0,REC1 ,XNEW,XOLD
  15695   "RTN","RCD PESP6",70, 0)
  15696    ;
  15697   "RTN","RCD PESP6",71, 0)
  15698    S (COUNT, HEAD)=0,HE AD("SIZE") =10
  15699   "RTN","RCD PESP6",72, 0)
  15700    S HEAD("T XT")="ALL  PAYERS"
  15701   "RTN","RCD PESP6",73, 0)
  15702    S HEAD("D ETAIL")=""
  15703   "RTN","RCD PESP6",74, 0)
  15704    S DOTS=$T R($J(" ",4 0)," ","." )
  15705   "RTN","RCD PESP6",75, 0)
  15706    ; Check p arameters  in 344.61  that apply  to all pa yers
  15707   "RTN","RCD PESP6",76, 0)
  15708    S REC0=$G (^TMP("RCD PESP6",$J, 344.61,1,0 ))
  15709   "RTN","RCD PESP6",77, 0)
  15710    ;
  15711   "RTN","RCD PESP6",78, 0)
  15712    ; Auto-po st med cla ims enable d
  15713   "RTN","RCD PESP6",79, 0)
  15714    S XOLD=$P (REC0,U,2)
  15715   "RTN","RCD PESP6",80, 0)
  15716    S XNEW=$$ GET1^DIQ(3 44.61,"1," ,.02,"I")
  15717   "RTN","RCD PESP6",81, 0)
  15718    I XNEW'=X OLD D  ;
  15719   "RTN","RCD PESP6",82, 0)
  15720    . D LNOUT (.HEAD,.LI NE,"AUTO-P OST MED CL AIMS ENABL ED",XOLD,X NEW,"B",.C OUNT)
  15721   "RTN","RCD PESP6",83, 0)
  15722    ;
  15723   "RTN","RCD PESP6",84, 0)
  15724    ; Auto-de crease med  enabled
  15725   "RTN","RCD PESP6",85, 0)
  15726    S XOLD=$P (REC0,U,3)
  15727   "RTN","RCD PESP6",86, 0)
  15728    S XNEW=$$ GET1^DIQ(3 44.61,"1," ,.03,"I")
  15729   "RTN","RCD PESP6",87, 0)
  15730    I XNEW'=X OLD D  ;
  15731   "RTN","RCD PESP6",88, 0)
  15732    . D LNOUT (.HEAD,.LI NE,"AUTO-D ECREASE ME D ENABLED" ,XOLD,XNEW ,"B",.COUN T)
  15733   "RTN","RCD PESP6",89, 0)
  15734    ;
  15735   "RTN","RCD PESP6",90, 0)
  15736    ; Auto-de crease med  days
  15737   "RTN","RCD PESP6",91, 0)
  15738    S XOLD=$P (REC0,U,4)
  15739   "RTN","RCD PESP6",92, 0)
  15740    S XNEW=$$ GET1^DIQ(3 44.61,"1," ,.04,"I")
  15741   "RTN","RCD PESP6",93, 0)
  15742    I XNEW'=X OLD D  ;
  15743   "RTN","RCD PESP6",94, 0)
  15744    . D LNOUT (.HEAD,.LI NE,"AUTO-D ECREASE DA YS DEFAULT ",XOLD,XNE W,"D",.COU NT)
  15745   "RTN","RCD PESP6",95, 0)
  15746    ;
  15747   "RTN","RCD PESP6",96, 0)
  15748    ; Auto-de crease no- pay med en abled
  15749   "RTN","RCD PESP6",97, 0)
  15750    S XOLD=$P (REC0,U,11 )
  15751   "RTN","RCD PESP6",98, 0)
  15752    S XNEW=$$ GET1^DIQ(3 44.61,"1," ,.11,"I")
  15753   "RTN","RCD PESP6",99, 0)
  15754    I XNEW'=X OLD D  ;
  15755   "RTN","RCD PESP6",100 ,0)
  15756    . D LNOUT (.HEAD,.LI NE,"AUTO-D ECREASE NO -PAY MED E NABLED",XO LD,XNEW,"B ",.COUNT)
  15757   "RTN","RCD PESP6",101 ,0)
  15758    ;
  15759   "RTN","RCD PESP6",102 ,0)
  15760    ; Auto-de crease no- pay med da ys
  15761   "RTN","RCD PESP6",103 ,0)
  15762    S XOLD=$P (REC0,U,12 )
  15763   "RTN","RCD PESP6",104 ,0)
  15764    S XNEW=$$ GET1^DIQ(3 44.61,"1," ,.12,"I")
  15765   "RTN","RCD PESP6",105 ,0)
  15766    I XNEW'=X OLD D  ;
  15767   "RTN","RCD PESP6",106 ,0)
  15768    . D LNOUT (.HEAD,.LI NE,"AUTO-D ECREASE NO -PAY DAYS  DEFAULT",X OLD,XNEW," D",.COUNT)
  15769   "RTN","RCD PESP6",107 ,0)
  15770    ;
  15771   "RTN","RCD PESP6",108 ,0)
  15772    ; Auto-de crease med  amount
  15773   "RTN","RCD PESP6",109 ,0)
  15774    S XOLD=$P (REC0,U,5)
  15775   "RTN","RCD PESP6",110 ,0)
  15776    S XNEW=$$ GET1^DIQ(3 44.61,"1," ,.05,"I")
  15777   "RTN","RCD PESP6",111 ,0)
  15778    I XNEW'=X OLD D  ;
  15779   "RTN","RCD PESP6",112 ,0)
  15780    . D LNOUT (.HEAD,.LI NE,"AUTO-D ECREASE AM T DEFAULT" ,XOLD,XNEW ,"$",.COUN T)
  15781   "RTN","RCD PESP6",113 ,0)
  15782    ;
  15783   "RTN","RCD PESP6",114 ,0)
  15784    ; TRICARE  EFT POST  PREVENT DA YS - PRCA* 4.5*332
  15785   "RTN","RCD PESP6",115 ,0)
  15786    S XOLD=$P (REC0,U,13 )
  15787   "RTN","RCD PESP6",116 ,0)
  15788    S XNEW=$$ GET1^DIQ(3 44.61,"1," ,.13,"I")
  15789   "RTN","RCD PESP6",117 ,0)
  15790    I XNEW'=X OLD D  ;
  15791   "RTN","RCD PESP6",118 ,0)
  15792    . D LNOUT (.HEAD,.LI NE,"TRICAR E EFT POST  PREVENT D AYS",XOLD, XNEW,"D",. COUNT)
  15793   "RTN","RCD PESP6",119 ,0)
  15794    ;
  15795   "RTN","RCD PESP6",120 ,0)
  15796    S REC1=$G (^TMP("RCD PESP6",$J, 344.61,1,1 ))
  15797   "RTN","RCD PESP6",121 ,0)
  15798    ; Auto-po st Rx
  15799   "RTN","RCD PESP6",122 ,0)
  15800    S XOLD=$P (REC1,U,1)
  15801   "RTN","RCD PESP6",123 ,0)
  15802    S XNEW=$$ GET1^DIQ(3 44.61,"1," ,1.01,"I")
  15803   "RTN","RCD PESP6",124 ,0)
  15804    I XNEW'=X OLD D  ;
  15805   "RTN","RCD PESP6",125 ,0)
  15806    . D LNOUT (.HEAD,.LI NE,"AUTO-P OST RX CLA IMS ENABLE D",XOLD,XN EW,"B",.CO UNT)
  15807   "RTN","RCD PESP6",126 ,0)
  15808    ;
  15809   "RTN","RCD PESP6",127 ,0)
  15810    ; Auto-de crease Rx
  15811   "RTN","RCD PESP6",128 ,0)
  15812    S XOLD=$P (REC1,U,2)
  15813   "RTN","RCD PESP6",129 ,0)
  15814    S XNEW=$$ GET1^DIQ(3 44.61,"1," ,1.02,"I")
  15815   "RTN","RCD PESP6",130 ,0)
  15816    I XNEW'=X OLD D  ;
  15817   "RTN","RCD PESP6",131 ,0)
  15818    . D LNOUT (.HEAD,.LI NE,"AUTO-D ECREASE RX  ENABLED", XOLD,XNEW, "B",.COUNT )
  15819   "RTN","RCD PESP6",132 ,0)
  15820    ;
  15821   "RTN","RCD PESP6",133 ,0)
  15822    ; Check e ach payer  in 344.6 f or changes
  15823   "RTN","RCD PESP6",134 ,0)
  15824    S IEN=0
  15825   "RTN","RCD PESP6",135 ,0)
  15826    F  S IEN= $O(^RCY(34 4.6,IEN))  Q:'IEN  D   ;
  15827   "RTN","RCD PESP6",136 ,0)
  15828    . S REC0= $G(^TMP("R CDPESP6",$ J,344.6,IE N,0))
  15829   "RTN","RCD PESP6",137 ,0)
  15830    . S HEAD= 0
  15831   "RTN","RCD PESP6",138 ,0)
  15832    . S HEAD( "DETAIL")= $$GET1^DIQ (344.6,IEN _",",.01," E") ; PRCA *4.5*332
  15833   "RTN","RCD PESP6",139 ,0)
  15834    . S HEAD( "TXT")="PA YER: "_HEA D("DETAIL" ) ; PRCA*4 .5*332
  15835   "RTN","RCD PESP6",140 ,0)
  15836    . ; Exclu de med cla ims postin g
  15837   "RTN","RCD PESP6",141 ,0)
  15838    . S XOLD= $P(REC0,U, 6)
  15839   "RTN","RCD PESP6",142 ,0)
  15840    . S XNEW= $$GET1^DIQ (344.6,IEN _",",.06," I")
  15841   "RTN","RCD PESP6",143 ,0)
  15842    . I XOLD' =XNEW D  ;
  15843   "RTN","RCD PESP6",144 ,0)
  15844    . . D LNO UT(.HEAD,. LINE,"EXCL UDE MED CL AIMS POSTI NG",XOLD,X NEW,"B",.C OUNT)
  15845   "RTN","RCD PESP6",145 ,0)
  15846    . ; Exclu de med cla ims decrea se
  15847   "RTN","RCD PESP6",146 ,0)
  15848    . S XOLD= $P(REC0,U, 7)
  15849   "RTN","RCD PESP6",147 ,0)
  15850    . S XNEW= $$GET1^DIQ (344.6,IEN _",",.07," I")
  15851   "RTN","RCD PESP6",148 ,0)
  15852    . I XOLD' =XNEW D  ;
  15853   "RTN","RCD PESP6",149 ,0)
  15854    . . D LNO UT(.HEAD,. LINE,"EXCL UDE MED CL AIMS DECRE ASE",XOLD, XNEW,"B",. COUNT)
  15855   "RTN","RCD PESP6",150 ,0)
  15856    . ; Exclu de Rx clai m posting
  15857   "RTN","RCD PESP6",151 ,0)
  15858    . S XOLD= $P(REC0,U, 8)
  15859   "RTN","RCD PESP6",152 ,0)
  15860    . S XNEW= $$GET1^DIQ (344.6,IEN _",",.08," I")
  15861   "RTN","RCD PESP6",153 ,0)
  15862    . I XOLD' =XNEW D  ;
  15863   "RTN","RCD PESP6",154 ,0)
  15864    . . D LNO UT(.HEAD,. LINE,"EXCL UDE RX CLA IM POSTING ",XOLD,XNE W,"B",.COU NT)
  15865   "RTN","RCD PESP6",155 ,0)
  15866    ;
  15867   "RTN","RCD PESP6",156 ,0)
  15868    ; Check e ach CARC-R ARC in 344 .62 for ch anges
  15869   "RTN","RCD PESP6",157 ,0)
  15870    S IEN=0
  15871   "RTN","RCD PESP6",158 ,0)
  15872    F  S IEN= $O(^RCY(34 4.62,IEN))  Q:'IEN  D   ;
  15873   "RTN","RCD PESP6",159 ,0)
  15874    . S REC0= $G(^TMP("R CDPESP6",$ J,344.62,I EN,0))
  15875   "RTN","RCD PESP6",160 ,0)
  15876    . S REC1= $G(^TMP("R CDPESP6",$ J,344.62,I EN,1))
  15877   "RTN","RCD PESP6",161 ,0)
  15878    . S HEAD= 0
  15879   "RTN","RCD PESP6",162 ,0)
  15880    . S HEAD( "DETAIL")= $$GET1^DIQ (344.62,IE N_",",.01, "E") ; PRC A*4.5*332
  15881   "RTN","RCD PESP6",163 ,0)
  15882    . S HEAD( "TXT")="CA RC/RARK CO DE: "_HEAD ("DETAIL")
  15883   "RTN","RCD PESP6",164 ,0)
  15884    . S REC0= $G(^TMP("R CDPESP6",$ J,344.62,I EN,0))
  15885   "RTN","RCD PESP6",165 ,0)
  15886    . ; CARC  auto decre ase
  15887   "RTN","RCD PESP6",166 ,0)
  15888    . S XOLD= $P(REC0,U, 2)
  15889   "RTN","RCD PESP6",167 ,0)
  15890    . S XNEW= $$GET1^DIQ (344.62,IE N_",",.02, "I")
  15891   "RTN","RCD PESP6",168 ,0)
  15892    . I XOLD' =XNEW D  ;
  15893   "RTN","RCD PESP6",169 ,0)
  15894    . . D LNO UT(.HEAD,. LINE,"CARC  AUTO DECR EASE",XOLD ,XNEW,"B", .COUNT)
  15895   "RTN","RCD PESP6",170 ,0)
  15896    . ; CARC  decrease a mount
  15897   "RTN","RCD PESP6",171 ,0)
  15898    . S XOLD= $P(REC0,U, 6)
  15899   "RTN","RCD PESP6",172 ,0)
  15900    . S XNEW= $$GET1^DIQ (344.62,IE N_",",.06, "I")
  15901   "RTN","RCD PESP6",173 ,0)
  15902    . I XOLD' =XNEW D  ;
  15903   "RTN","RCD PESP6",174 ,0)
  15904    . . D LNO UT(.HEAD,. LINE,"CARC  DECREASE  AMOUNT",XO LD,XNEW,"$ ",.COUNT)
  15905   "RTN","RCD PESP6",175 ,0)
  15906    . ;
  15907   "RTN","RCD PESP6",176 ,0)
  15908    . ; CARC  auto decre ase no-pay
  15909   "RTN","RCD PESP6",177 ,0)
  15910    . S XOLD= $P(REC1,U, 1)
  15911   "RTN","RCD PESP6",178 ,0)
  15912    . S XNEW= $$GET1^DIQ (344.62,IE N_",",.08, "I")
  15913   "RTN","RCD PESP6",179 ,0)
  15914    . I XOLD' =XNEW D  ;
  15915   "RTN","RCD PESP6",180 ,0)
  15916    . . D LNO UT(.HEAD,. LINE,"CARC  AUTO DECR EASE NO-PA Y",XOLD,XN EW,"B",.CO UNT)
  15917   "RTN","RCD PESP6",181 ,0)
  15918    . ; CARC  decrease a mount no p ay
  15919   "RTN","RCD PESP6",182 ,0)
  15920    . S XOLD= $P(REC1,U, 5)
  15921   "RTN","RCD PESP6",183 ,0)
  15922    . S XNEW= $$GET1^DIQ (344.62,IE N_",",.12, "I")
  15923   "RTN","RCD PESP6",184 ,0)
  15924    . I XOLD' =XNEW D  ;
  15925   "RTN","RCD PESP6",185 ,0)
  15926    . . D LNO UT(.HEAD,. LINE,"CARC  DECREASE  AMOUNT NO- PAY",XOLD, XNEW,"$",. COUNT)
  15927   "RTN","RCD PESP6",186 ,0)
  15928    ;
  15929   "RTN","RCD PESP6",187 ,0)
  15930    Q COUNT
  15931   "RTN","RCD PESP6",188 ,0)
  15932    ;
  15933   "RTN","RCD PESP6",189 ,0)
  15934   LNOUT(HEAD ,LINE,TXT, XOLD,XNEW, TYPE,COUNT )   ; Form at a line  for the me ssage
  15935   "RTN","RCD PESP6",190 ,0)
  15936    ; Input:  TXT - Desc ription of  the chang ed field
  15937   "RTN","RCD PESP6",191 ,0)
  15938    ;         XOLD - Old  Value (In ternal for mat)
  15939   "RTN","RCD PESP6",192 ,0)
  15940    ;         XNEW - New  Value (In ternal For mat)
  15941   "RTN","RCD PESP6",193 ,0)
  15942    ;         Type - "B"  - Boolean  1-Yes, 0  - N
  15943   "RTN","RCD PESP6",194 ,0)
  15944    ;                "$"  - Dollar  amount
  15945   "RTN","RCD PESP6",195 ,0)
  15946    ;                "D"  - Days
  15947   "RTN","RCD PESP6",196 ,0)
  15948    ;                "T"  - Text
  15949   "RTN","RCD PESP6",197 ,0)
  15950    ; Output:  COUNT pas sed by ref erence
  15951   "RTN","RCD PESP6",198 ,0)
  15952    ;          HEAD pass ed by refe rence
  15953   "RTN","RCD PESP6",199 ,0)
  15954    ;          LINE pass ed by refe rence
  15955   "RTN","RCD PESP6",200 ,0)
  15956    ;                
  15957   "RTN","RCD PESP6",201 ,0)
  15958    N RCFDA,R CIENS,RETU RN
  15959   "RTN","RCD PESP6",202 ,0)
  15960    ; Output  header for  this sect ion if not  already d one 
  15961   "RTN","RCD PESP6",203 ,0)
  15962    I 'HEAD D   ;
  15963   "RTN","RCD PESP6",204 ,0)
  15964    . S COUNT =COUNT+1
  15965   "RTN","RCD PESP6",205 ,0)
  15966    . S LINE( COUNT+HEAD ("SIZE"))= HEAD("TXT" )
  15967   "RTN","RCD PESP6",206 ,0)
  15968    . S HEAD= 1
  15969   "RTN","RCD PESP6",207 ,0)
  15970    ;
  15971   "RTN","RCD PESP6",208 ,0)
  15972    S COUNT=C OUNT+1
  15973   "RTN","RCD PESP6",209 ,0)
  15974    S LINE(CO UNT+HEAD(" SIZE"))=$E (" "_TXT_D OTS,1,50)
  15975   "RTN","RCD PESP6",210 ,0)
  15976    S LINE(CO UNT+HEAD(" SIZE"))=LI NE(COUNT+H EAD("SIZE" ))_$J($$FO RMAT(XOLD, TYPE),10)_ " "_$J($$F ORMAT(XNEW ,TYPE),10)
  15977   "RTN","RCD PESP6",211 ,0)
  15978    ;
  15979   "RTN","RCD PESP6",212 ,0)
  15980    ;PRCA*4.5 *332 - Sav e changes  into multi ple 344.61 1 for hist ory report
  15981   "RTN","RCD PESP6",213 ,0)
  15982    S RCIENS= "+1,1,"
  15983   "RTN","RCD PESP6",214 ,0)
  15984    S RCFDA(3 44.611,RCI ENS,.01)=$ $NOW^XLFDT ()
  15985   "RTN","RCD PESP6",215 ,0)
  15986    S RCFDA(3 44.611,RCI ENS,.02)=D UZ
  15987   "RTN","RCD PESP6",216 ,0)
  15988    S RCFDA(3 44.611,RCI ENS,1)=TXT
  15989   "RTN","RCD PESP6",217 ,0)
  15990    S RCFDA(3 44.611,RCI ENS,2)=HEA D("DETAIL" )
  15991   "RTN","RCD PESP6",218 ,0)
  15992    S RCFDA(3 44.611,RCI ENS,3)=$$F ORMAT(XOLD ,TYPE)
  15993   "RTN","RCD PESP6",219 ,0)
  15994    S RCFDA(3 44.611,RCI ENS,4)=$$F ORMAT(XNEW ,TYPE)
  15995   "RTN","RCD PESP6",220 ,0)
  15996    D UPDATE^ DIE("","RC FDA","RCIE NS")
  15997   "RTN","RCD PESP6",221 ,0)
  15998    Q
  15999   "RTN","RCD PESP6",222 ,0)
  16000    ;
  16001   "RTN","RCD PESP6",223 ,0)
  16002   FORMAT(VAL UE,TYPE) ;  Format a  value for  output - A dded for P RCA*4.5*33 2
  16003   "RTN","RCD PESP6",224 ,0)
  16004    ; Input:  VALUE - Va lue to be  formated
  16005   "RTN","RCD PESP6",225 ,0)
  16006    ; TYPE -  "$" - Doll ar amount,  B - Boole an
  16007   "RTN","RCD PESP6",226 ,0)
  16008    ; Return:  Formated  value
  16009   "RTN","RCD PESP6",227 ,0)
  16010    ;
  16011   "RTN","RCD PESP6",228 ,0)
  16012    S RETURN= VALUE
  16013   "RTN","RCD PESP6",229 ,0)
  16014    I TYPE="B " D  ;
  16015   "RTN","RCD PESP6",230 ,0)
  16016    . S RETUR N=$S(VALUE :"YES",1:" NO")
  16017   "RTN","RCD PESP6",231 ,0)
  16018    I TYPE="$ " D  ;
  16019   "RTN","RCD PESP6",232 ,0)
  16020    . S RETUR N=$FN(VALU E,",",2)
  16021   "RTN","RCD PESP6",233 ,0)
  16022    Q RETURN
  16023   "RTN","RCD PESP6",234 ,0)
  16024    ;
  16025   "RTN","RCD PESP6",235 ,0)
  16026   PAYEN ; (E N) On entr y into ide ntify paye rs option,  save a sn apshot of  file 344.6  - Added f or PRCA*4. 5*332
  16027   "RTN","RCD PESP6",236 ,0)
  16028    ; Input:  None
  16029   "RTN","RCD PESP6",237 ,0)
  16030    ; Output:  ^TMP("RCD PESP6",$J)  created b y merging  in files 3 44.6, 344. 61 and 344 .62
  16031   "RTN","RCD PESP6",238 ,0)
  16032    K ^TMP("R CDPESP6",$ J)
  16033   "RTN","RCD PESP6",239 ,0)
  16034    M ^TMP("R CDPESP6",$ J,344.6)=^ RCY(344.6)  ; Save pa yer exclus ions
  16035   "RTN","RCD PESP6",240 ,0)
  16036    Q
  16037   "RTN","RCD PESP6",241 ,0)
  16038   PAYEX ; (E N) On exit  from iden tify payer s option,  compare sn apshot wit h live fil es. - Adde d for PRCA *4.5*332
  16039   "RTN","RCD PESP6",242 ,0)
  16040    ; Save ch anges to t he paramet er audit m ultiple 34 4.611
  16041   "RTN","RCD PESP6",243 ,0)
  16042    ; Input:  ^TMP("RCDP ESP6",$J)  created ab ove by mer ging in fi le 344.6
  16043   "RTN","RCD PESP6",244 ,0)
  16044    ; Output:  Enties in  multiple  344.611 to  keep hist ory of pay er flag ch anges
  16045   "RTN","RCD PESP6",245 ,0)
  16046    ;
  16047   "RTN","RCD PESP6",246 ,0)
  16048    N COUNT,D OTS,IEN,RE C0,HEAD,LI NE,XOLD,XN EW
  16049   "RTN","RCD PESP6",247 ,0)
  16050    ;
  16051   "RTN","RCD PESP6",248 ,0)
  16052    S HEAD=0, HEAD("SIZE ")=10
  16053   "RTN","RCD PESP6",249 ,0)
  16054    S DOTS=""  F J=1:1:4 0 S DOTS=D OTS_"."
  16055   "RTN","RCD PESP6",250 ,0)
  16056    ;
  16057   "RTN","RCD PESP6",251 ,0)
  16058    S COUNT=0
  16059   "RTN","RCD PESP6",252 ,0)
  16060    ; Check e ach payer  in 344.6 f or changes
  16061   "RTN","RCD PESP6",253 ,0)
  16062    S IEN=0
  16063   "RTN","RCD PESP6",254 ,0)
  16064    F  S IEN= $O(^RCY(34 4.6,IEN))  Q:'IEN  D   ;
  16065   "RTN","RCD PESP6",255 ,0)
  16066    . S REC0= $G(^TMP("R CDPESP6",$ J,344.6,IE N,0))
  16067   "RTN","RCD PESP6",256 ,0)
  16068    . S HEAD( "DETAIL")= $$GET1^DIQ (344.6,IEN _",",.01," E")
  16069   "RTN","RCD PESP6",257 ,0)
  16070    . S HEAD( "TXT")="PA YER: "_HEA D("DETAIL" )
  16071   "RTN","RCD PESP6",258 ,0)
  16072    . ; Pharm acy Flag
  16073   "RTN","RCD PESP6",259 ,0)
  16074    . S XOLD= $P(REC0,U, 9)
  16075   "RTN","RCD PESP6",260 ,0)
  16076    . S XNEW= $$GET1^DIQ (344.6,IEN _",",.09," I")
  16077   "RTN","RCD PESP6",261 ,0)
  16078    . I (+XOL D)'=(+XNEW ) D  ;
  16079   "RTN","RCD PESP6",262 ,0)
  16080    . . D LNO UT(.HEAD,. LINE,"PHAR MACY FLAG" ,XOLD,XNEW ,"B",.COUN T)
  16081   "RTN","RCD PESP6",263 ,0)
  16082    . ; Trica re flag
  16083   "RTN","RCD PESP6",264 ,0)
  16084    . S XOLD= $P(REC0,U, 10)
  16085   "RTN","RCD PESP6",265 ,0)
  16086    . S XNEW= $$GET1^DIQ (344.6,IEN _",",.1,"I ")
  16087   "RTN","RCD PESP6",266 ,0)
  16088    . I (+XOL D)'=(+XNEW ) D  ;
  16089   "RTN","RCD PESP6",267 ,0)
  16090    . . D LNO UT(.HEAD,. LINE,"TRIC ARE FLAG", XOLD,XNEW, "B",.COUNT )
  16091   "RTN","RCD PESP6",268 ,0)
  16092    Q
  16093   "RTN","RCD PESP6",269 ,0)
  16094    ;
  16095   "RTN","RCD PESP8")
  16096   0^10^B2220 9300
  16097   "RTN","RCD PESP8",1,0 )
  16098   RCDPESP8 ; AITC/CJE -  ePayment  Lockbox Si te Paramet ers Histor y
  16099   "RTN","RCD PESP8",2,0 )
  16100    ;;4.5;Acc ounts Rece ivable;**3 32**;Mar 2 0, 1995;Bu ild 34
  16101   "RTN","RCD PESP8",3,0 )
  16102    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  16103   "RTN","RCD PESP8",4,0 )
  16104    ;
  16105   "RTN","RCD PESP8",5,0 )
  16106   EN ; entry  point for  EDI Lockb ox Paramet ers Histor y Report [ RCDPE PARA METER HIST ORY REPORT ]
  16107   "RTN","RCD PESP8",6,0 )
  16108    N BDATE,E DATE,RCHDR ,IEN2,POP, RCDATE,RCD ISPTY,RCEN D,RCLN,RCN EW,RCOLD,R CPGNUM,RCS TOP,RCTMPN D,RCUSRVAL MHDR
  16109   "RTN","RCD PESP8",7,0 )
  16110    K ^TMP($J ,"RCDPESP8 ")
  16111   "RTN","RCD PESP8",8,0 )
  16112    Q:$$PROMP TS(.BDATE, .EDATE,.RC LM)=-1  ;  Prompt for  report pa rameters
  16113   "RTN","RCD PESP8",9,0 )
  16114    ;
  16115   "RTN","RCD PESP8",10, 0)
  16116    S RCPGNUM =0,RCSTOP= 0
  16117   "RTN","RCD PESP8",11, 0)
  16118    I RCLM D   G EXIT
  16119   "RTN","RCD PESP8",12, 0)
  16120    . S RCTMP ND="RCDPES P8"  K ^TM P($J,RCTMP ND)  ; cle an any res idue
  16121   "RTN","RCD PESP8",13, 0)
  16122    . D COMPI LE
  16123   "RTN","RCD PESP8",14, 0)
  16124    . D LMRPT ^RCDPEARL( .VALMHDR,$ NA(^TMP($J ,RCTMPND)) ) ; genera te ListMan  display
  16125   "RTN","RCD PESP8",15, 0)
  16126    . I $D(RC TMPND) K ^ TMP($J,RCT MPND)
  16127   "RTN","RCD PESP8",16, 0)
  16128    ;
  16129   "RTN","RCD PESP8",17, 0)
  16130    W !
  16131   "RTN","RCD PESP8",18, 0)
  16132    S %ZIS="Q M" D ^%ZIS  Q:POP
  16133   "RTN","RCD PESP8",19, 0)
  16134    I $D(IO(" Q")) D  Q
  16135   "RTN","RCD PESP8",20, 0)
  16136    .N ZTDESC ,ZTRTN,ZTS AVE,ZTSK
  16137   "RTN","RCD PESP8",21, 0)
  16138    .S ZTRTN= "COMPILE^R CDPESP8",Z TDESC="EDI  LOCKBOX A UTO PARAME TER HISTOR Y REPORT"
  16139   "RTN","RCD PESP8",22, 0)
  16140    .S ZTSAVE ("*")=""
  16141   "RTN","RCD PESP8",23, 0)
  16142    .D ^%ZTLO AD
  16143   "RTN","RCD PESP8",24, 0)
  16144    .W !!,$S( $D(ZTSK):" Your task  number"_ZT SK_" has b een queued .",1:"Unab le to queu e this job .")
  16145   "RTN","RCD PESP8",25, 0)
  16146    .K IO("Q" ) D HOME^% ZIS
  16147   "RTN","RCD PESP8",26, 0)
  16148    ;
  16149   "RTN","RCD PESP8",27, 0)
  16150    U IO
  16151   "RTN","RCD PESP8",28, 0)
  16152    D COMPILE
  16153   "RTN","RCD PESP8",29, 0)
  16154    I 'RCSTOP  D ASK^RCD PEARL(.RCS TOP)
  16155   "RTN","RCD PESP8",30, 0)
  16156    ;
  16157   "RTN","RCD PESP8",31, 0)
  16158    Q
  16159   "RTN","RCD PESP8",32, 0)
  16160   COMPILE ;  Get data f or user se lected dat e range
  16161   "RTN","RCD PESP8",33, 0)
  16162    N IEN2,LI NE,LMHDR,R CDET,RCPAR AM,RCSEQ,R CUSR,SPACE ,SPLIT
  16163   "RTN","RCD PESP8",34, 0)
  16164    S SPACE=$ J("",40)
  16165   "RTN","RCD PESP8",35, 0)
  16166    S RCSEQ=0
  16167   "RTN","RCD PESP8",36, 0)
  16168    S RCDATE= BDATE,RCEN D=EDATE_". "_24
  16169   "RTN","RCD PESP8",37, 0)
  16170    F  S RCDA TE=$O(^RCY (344.61,1, 2,"ADU",RC DATE)) Q:( RCDATE>RCE ND)!(RCDAT E="")  D   ;
  16171   "RTN","RCD PESP8",38, 0)
  16172    . S RCUSR =""
  16173   "RTN","RCD PESP8",39, 0)
  16174    . F  S RC USR=$O(^RC Y(344.61,1 ,2,"ADU",R CDATE,RCUS R)) Q:RCUS R=""  D  ;
  16175   "RTN","RCD PESP8",40, 0)
  16176    . . S RCS EQ=RCSEQ+1
  16177   "RTN","RCD PESP8",41, 0)
  16178    . . S ^TM P($J,"RCDP ESP8",RCSE Q)=$E($$FM TE^XLFDT(R CDATE,"2Z" )_SPACE,1, 19)_RCUSR
  16179   "RTN","RCD PESP8",42, 0)
  16180    . . S IEN 2=""
  16181   "RTN","RCD PESP8",43, 0)
  16182    . . F  S  IEN2=$O(^R CY(344.61, 1,2,"ADU", RCDATE,RCU SR,IEN2))  Q:IEN2=""   D  ;
  16183   "RTN","RCD PESP8",44, 0)
  16184    . . . S R CPARAM=$$G ET1^DIQ(34 4.611,IEN2 _",1,",1," E")
  16185   "RTN","RCD PESP8",45, 0)
  16186    . . . S R CDET=$$GET 1^DIQ(344. 611,IEN2_" ,1,",2,"E" )
  16187   "RTN","RCD PESP8",46, 0)
  16188    . . . S R COLD=$$GET 1^DIQ(344. 611,IEN2_" ,1,",3,"E" )
  16189   "RTN","RCD PESP8",47, 0)
  16190    . . . S R CNEW=$$GET 1^DIQ(344. 611,IEN2_" ,1,",4,"E" )
  16191   "RTN","RCD PESP8",48, 0)
  16192    . . . S S PLIT=0
  16193   "RTN","RCD PESP8",49, 0)
  16194    . . . S R CSEQ=RCSEQ +1
  16195   "RTN","RCD PESP8",50, 0)
  16196    . . . S L INE="  "_R CPARAM
  16197   "RTN","RCD PESP8",51, 0)
  16198    . . . I $ L(LINE_" ( "_RCDET_") ")>62 S SP LIT=1
  16199   "RTN","RCD PESP8",52, 0)
  16200    . . . I ' SPLIT D  ;
  16201   "RTN","RCD PESP8",53, 0)
  16202    . . . . I  RCDET'=""  S LINE=LI NE_" ("_RC DET_")"
  16203   "RTN","RCD PESP8",54, 0)
  16204    . . . . S  LINE=LINE _$J("",62- $L(LINE))_ " "_$J(RCO LD,8)_" "_ $J(RCNEW,8 )
  16205   "RTN","RCD PESP8",55, 0)
  16206    . . . S ^ TMP($J,"RC DPESP8",RC SEQ)=LINE
  16207   "RTN","RCD PESP8",56, 0)
  16208    . . . I S PLIT D  ;
  16209   "RTN","RCD PESP8",57, 0)
  16210    . . . . S  RCSEQ=RCS EQ+1
  16211   "RTN","RCD PESP8",58, 0)
  16212    . . . . S  LINE="     "_$E(RCDE T,1,58)
  16213   "RTN","RCD PESP8",59, 0)
  16214    . . . . S  LINE=LINE _$J("",62- $L(LINE))_ " "_$J(RCO LD,8)_" "_ $J(RCNEW,8 )
  16215   "RTN","RCD PESP8",60, 0)
  16216    . . . . S  ^TMP($J," RCDPESP8", RCSEQ)=LIN E
  16217   "RTN","RCD PESP8",61, 0)
  16218    I 'RCLM D   ;
  16219   "RTN","RCD PESP8",62, 0)
  16220    . D OUTPU T
  16221   "RTN","RCD PESP8",63, 0)
  16222    E  D  ;
  16223   "RTN","RCD PESP8",64, 0)
  16224    . D HEAD
  16225   "RTN","RCD PESP8",65, 0)
  16226    . S LMHDR ("TITLE")= "Auto Para meter Hist ory Report "
  16227   "RTN","RCD PESP8",66, 0)
  16228    . S LMHDR (1)=RCHDR( 2)
  16229   "RTN","RCD PESP8",67, 0)
  16230    . S LMHDR (2)=RCHDR( 3)
  16231   "RTN","RCD PESP8",68, 0)
  16232    . S LMHDR (3)=""
  16233   "RTN","RCD PESP8",69, 0)
  16234    . S LMHDR (4)=""
  16235   "RTN","RCD PESP8",70, 0)
  16236    . S LMHDR (5)=""
  16237   "RTN","RCD PESP8",71, 0)
  16238    . S LMHDR (6)=RCHDR( 5)
  16239   "RTN","RCD PESP8",72, 0)
  16240    . S LMHDR (7)=RCHDR( 6)
  16241   "RTN","RCD PESP8",73, 0)
  16242    . D LMRPT ^RCDPEARL( .LMHDR,$NA (^TMP($J," RCDPESP8") )) ; Gener ate ListMa n display
  16243   "RTN","RCD PESP8",74, 0)
  16244    ;
  16245   "RTN","RCD PESP8",75, 0)
  16246   EXIT ; Exi t point to  clean up  ^TMP
  16247   "RTN","RCD PESP8",76, 0)
  16248    K ^TMP($J ,"RCDPESP8 ")
  16249   "RTN","RCD PESP8",77, 0)
  16250    Q
  16251   "RTN","RCD PESP8",78, 0)
  16252    ;
  16253   "RTN","RCD PESP8",79, 0)
  16254   OUTPUT ; O utput prin ted report  to screen  or printe r
  16255   "RTN","RCD PESP8",80, 0)
  16256    S RCPGNUM =0
  16257   "RTN","RCD PESP8",81, 0)
  16258    D HEAD
  16259   "RTN","RCD PESP8",82, 0)
  16260    S RCSEQ=0
  16261   "RTN","RCD PESP8",83, 0)
  16262    F  S RCSE Q=$O(^TMP( $J,"RCDPES P8",RCSEQ) ) Q:'RCSEQ   D  I RCS TOP Q
  16263   "RTN","RCD PESP8",84, 0)
  16264    . I $Y>(I OSL-3)!(RC PGNUM=0) D  HDRLST^RC DPEARL(.RC STOP,.RCHD R) I RCSTO P Q
  16265   "RTN","RCD PESP8",85, 0)
  16266    . W !,^TM P($J,"RCDP ESP8",RCSE Q)
  16267   "RTN","RCD PESP8",86, 0)
  16268    Q
  16269   "RTN","RCD PESP8",87, 0)
  16270   HEAD ; Pri nt header
  16271   "RTN","RCD PESP8",88, 0)
  16272    N LINE
  16273   "RTN","RCD PESP8",89, 0)
  16274    S LINE="A uto Parame ter Histor y Report"
  16275   "RTN","RCD PESP8",90, 0)
  16276    S LINE=$J ("",(80-$L (LINE)\2)) _LINE
  16277   "RTN","RCD PESP8",91, 0)
  16278    S RCHDR(" H")=LINE_$ J("",71-$L (LINE))
  16279   "RTN","RCD PESP8",92, 0)
  16280    S LINE="R UN DATE: " _$$FMTE^XL FDT($$NOW^ XLFDT,"2Z" )
  16281   "RTN","RCD PESP8",93, 0)
  16282    S RCHDR(2 )=$J("",(8 0-$L(LINE) \2))_LINE
  16283   "RTN","RCD PESP8",94, 0)
  16284    S LINE="D ATE RANGE:  "_$$FMTE^ XLFDT(BDAT E,"2DZ")_"  - "_$$FMT E^XLFDT(ED ATE,"2DZ")
  16285   "RTN","RCD PESP8",95, 0)
  16286    S RCHDR(3 )=$J("",(8 0-$L(LINE) \2))_LINE
  16287   "RTN","RCD PESP8",96, 0)
  16288    S RCHDR(4 )=""
  16289   "RTN","RCD PESP8",97, 0)
  16290    S LINE="D ate/Time E dited   Us er"_$J("", 48)_"Value s"
  16291   "RTN","RCD PESP8",98, 0)
  16292    S RCHDR(5 )=LINE
  16293   "RTN","RCD PESP8",99, 0)
  16294    S LINE="   Parameter "_$J("",57 )_"Old       New"
  16295   "RTN","RCD PESP8",100 ,0)
  16296    S RCHDR(6 )=LINE
  16297   "RTN","RCD PESP8",101 ,0)
  16298    S RCHDR(7 )=$TR($J(" ",80)," ", "=")
  16299   "RTN","RCD PESP8",102 ,0)
  16300    S RCHDR(" XECUTE")=" S RCPGNUM= RCPGNUM+1, RCHDR(1)=R CHDR(""H"" )_""Page:  ""_RCPGNUM "
  16301   "RTN","RCD PESP8",103 ,0)
  16302    S RCDISPT Y=$S(RCLM: 1,1:0)
  16303   "RTN","RCD PESP8",104 ,0)
  16304    S RCHDR(0 )=7
  16305   "RTN","RCD PESP8",105 ,0)
  16306    ;
  16307   "RTN","RCD PESP8",106 ,0)
  16308    S VALMHDR (1)=RCHDR( "H")
  16309   "RTN","RCD PESP8",107 ,0)
  16310    S VALMHDR (2)=RCHDR( 3)
  16311   "RTN","RCD PESP8",108 ,0)
  16312    S VALMHDR (3)=""
  16313   "RTN","RCD PESP8",109 ,0)
  16314    S VALMHDR (4)=RCHDR( 5)
  16315   "RTN","RCD PESP8",110 ,0)
  16316    S VALMHDR (5)=RCHDR( 6)
  16317   "RTN","RCD PESP8",111 ,0)
  16318    Q
  16319   "RTN","RCD PESP8",112 ,0)
  16320    ;
  16321   "RTN","RCD PESP8",113 ,0)
  16322   PROMPTS(BD ATE,EDATE, RCLM,RCXL)  ; Propmt  for report  Parameter s
  16323   "RTN","RCD PESP8",114 ,0)
  16324    ; Input:  None
  16325   "RTN","RCD PESP8",115 ,0)
  16326    ; Output:   BDATE -  Start date  for repor t in FileM an interna l format
  16327   "RTN","RCD PESP8",116 ,0)
  16328    ;           EDATE -  End date f or report  in Fileman  internal  format
  16329   "RTN","RCD PESP8",117 ,0)
  16330    ;           RCLM - B oolean fla g - displa y in ListM an
  16331   "RTN","RCD PESP8",118 ,0)
  16332    ; Returns : -1 Quit  without ru nning repo rt
  16333   "RTN","RCD PESP8",119 ,0)
  16334    ;            1 Conti nue
  16335   "RTN","RCD PESP8",120 ,0)
  16336    ;
  16337   "RTN","RCD PESP8",121 ,0)
  16338    N DIR,RET URN,Y
  16339   "RTN","RCD PESP8",122 ,0)
  16340    S RETURN= 1
  16341   "RTN","RCD PESP8",123 ,0)
  16342    S DIR("?" )="ENTER T HE DATE OF  THE EARIE ST PARAMET ER CHANGE  TO INCLUDE "
  16343   "RTN","RCD PESP8",124 ,0)
  16344    S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="St art Date:  ",DIR("B") ="T" D ^DI R K DIR
  16345   "RTN","RCD PESP8",125 ,0)
  16346    I $D(DTOU T)!$D(DUOU T)!(Y="")  S RETURN=- 1 G PQ
  16347   "RTN","RCD PESP8",126 ,0)
  16348    S BDATE=Y
  16349   "RTN","RCD PESP8",127 ,0)
  16350    ;
  16351   "RTN","RCD PESP8",128 ,0)
  16352    K DIR
  16353   "RTN","RCD PESP8",129 ,0)
  16354    S DIR("?" )="ENTER T HE DATE OF  THE LATES T PARAMETE R CHANGE T O INCLUDE"
  16355   "RTN","RCD PESP8",130 ,0)
  16356    S DIR("B" )="T"
  16357   "RTN","RCD PESP8",131 ,0)
  16358    S DIR(0)= "DAO^"_BDA TE_":"_DT_ ":APE",DIR ("A")="End  Date: " D  ^DIR K DI R
  16359   "RTN","RCD PESP8",132 ,0)
  16360    I $D(DTOU T)!$D(DUOU T)!(Y="")  S RETURN=- 1 G PQ
  16361   "RTN","RCD PESP8",133 ,0)
  16362    S EDATE=Y
  16363   "RTN","RCD PESP8",134 ,0)
  16364    ;
  16365   "RTN","RCD PESP8",135 ,0)
  16366    S RCLM=$$ ASKLM^RCDP EARL() I R CLM=-1 S R ETURN=-1
  16367   "RTN","RCD PESP8",136 ,0)
  16368   PQ ; Commo n exit poi nt for PRO MPTS 
  16369   "RTN","RCD PESP8",137 ,0)
  16370    Q RETURN
  16371   "RTN","RCD PESPA")
  16372   0^24^B7201 5265
  16373   "RTN","RCD PESPA",1,0 )
  16374   RCDPESPA ; OICO/hrub  - ePayment  Lockbox P arameter A udit Repor t ;12 Oct  2018 09:59 :54
  16375   "RTN","RCD PESPA",2,0 )
  16376    ;;4.5;Acc ounts Rece ivable;*33 2**;Oct 11 , 2018;Bui ld 34
  16377   "RTN","RCD PESPA",3,0 )
  16378    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  16379   "RTN","RCD PESPA",4,0 )
  16380    ;
  16381   "RTN","RCD PESPA",5,0 )
  16382    Q
  16383   "RTN","RCD PESPA",6,0 )
  16384    ;
  16385   "RTN","RCD PESPA",7,0 )
  16386   AUDPARM ;  EDI Lockbo x Paramete rs Audit R eport [RCD PE PARAMET ER AUDIT R EPORT]
  16387   "RTN","RCD PESPA",8,0 )
  16388    ; report  logic move d from RCD PESP2, 11  October 20 18
  16389   "RTN","RCD PESPA",9,0 )
  16390    ; report  is a listi ng of the  RCDPE PARA METER AUDI T file (#3 44.7)
  16391   "RTN","RCD PESPA",10, 0)
  16392    ; includi ng changes  to the RC DPE PARAME TER file ( #344.61)
  16393   "RTN","RCD PESPA",11, 0)
  16394    ;
  16395   "RTN","RCD PESPA",12, 0)
  16396    ; ^TMP($T (+0)_"-AUD ",$J) - st orage for  LIST^DIC o utput
  16397   "RTN","RCD PESPA",13, 0)
  16398    ; ^TMP($J ,"RCLABEL" ) - field  labels fro m $$GET1^D ID
  16399   "RTN","RCD PESPA",14, 0)
  16400    ; RCDIERR  - errors  from LIST^ DIC
  16401   "RTN","RCD PESPA",15, 0)
  16402    ; RCDIGET  - ^TMP st orage for  LIST^DIC
  16403   "RTN","RCD PESPA",16, 0)
  16404    ; RCFLDS  - fields f or LIST^DI C
  16405   "RTN","RCD PESPA",17, 0)
  16406    ; RCPARAM  - changed  parameter
  16407   "RTN","RCD PESPA",18, 0)
  16408    ; RCPARAM ("dt&tm")   - date an d time par ameter cha nged
  16409   "RTN","RCD PESPA",19, 0)
  16410    ; RCPARAM ("file") -  file numb er
  16411   "RTN","RCD PESPA",20, 0)
  16412    ; RCPARAM ("fld") -  field numb er
  16413   "RTN","RCD PESPA",21, 0)
  16414    ; RCPARAM ("newVal")  - new par ameter val ue
  16415   "RTN","RCD PESPA",22, 0)
  16416    ; RCPARAM ("oldVal")  - old par ameter val ue
  16417   "RTN","RCD PESPA",23, 0)
  16418    ; RCPARAM ("usr") -  user who c hanged par ameter
  16419   "RTN","RCD PESPA",24, 0)
  16420    ; RCRPRT( "begDate")   - report  start dat e
  16421   "RTN","RCD PESPA",25, 0)
  16422    ; RCRPRT( "endDate")   - report  end date
  16423   "RTN","RCD PESPA",26, 0)
  16424    ; RCRPRT( "eXcel") -  flag, out put to Exc el?
  16425   "RTN","RCD PESPA",27, 0)
  16426    ; RCRPRT( "hdrDate")  - date/ti me report  was run
  16427   "RTN","RCD PESPA",28, 0)
  16428    ; RCRPRT( "hdrPg#")   - page co unter
  16429   "RTN","RCD PESPA",29, 0)
  16430    ; RCRPRT( "hdrTyp")  - type to  display in  header
  16431   "RTN","RCD PESPA",30, 0)
  16432    ; RCRPRT( "pgLns") -  line coun t for page  (or scree n)
  16433   "RTN","RCD PESPA",31, 0)
  16434    ; RCRPRT( "typRprt")  - type of  report (M edical, Ph armacy, Tr icare of A ll)
  16435   "RTN","RCD PESPA",32, 0)
  16436    ; RCRPRT( "cntr") -  count of r ecords out put
  16437   "RTN","RCD PESPA",33, 0)
  16438    ; RCSCR   - screenin g logic fo r LIST^DIC
  16439   "RTN","RCD PESPA",34, 0)
  16440    ; RCSTOP  - flag, st op display ing report
  16441   "RTN","RCD PESPA",35, 0)
  16442    ; RCTMP   - one line  from LIST ^DIC
  16443   "RTN","RCD PESPA",36, 0)
  16444    N %ZIS,PO P,RCDIERR, RCDIGET,RC FLDS,RCIEN ,RCPARAM,R CRPRT,RCSC R,RCSTOP,R CTMP,X,Y
  16445   "RTN","RCD PESPA",37, 0)
  16446    W !!,"EDI  Lockbox P arameters  Audit Repo rt",!
  16447   "RTN","RCD PESPA",38, 0)
  16448    ; set up  FileMan st orage loca tion
  16449   "RTN","RCD PESPA",39, 0)
  16450    S RCDIGET =$NA(^TMP( $T(+0)_"-A UD",$J)) K  @RCDIGET, ^TMP($J,"R CLABEL")
  16451   "RTN","RCD PESPA",40, 0)
  16452    ; initial ize to zer o
  16453   "RTN","RCD PESPA",41, 0)
  16454    S (RCSTOP ,RCRPRT("h drPg#"),RC RPRT("eXce l"),RCRPRT ("cntr"),R CRPRT("pgL ns"))=0
  16455   "RTN","RCD PESPA",42, 0)
  16456    ; retriev e report t ype (Medic al, Pharma cy, or Bot h)
  16457   "RTN","RCD PESPA",43, 0)
  16458    S RCRPRT( "typRprt") =$$RTYPE(" B")  ; def ault is Bo th
  16459   "RTN","RCD PESPA",44, 0)
  16460    Q:RCRPRT( "typRprt") =-1
  16461   "RTN","RCD PESPA",45, 0)
  16462    ; type fo r header
  16463   "RTN","RCD PESPA",46, 0)
  16464    S RCRPRT( "hdrTyp")= $S(RCRPRT( "typRprt") ="M":"Medi cal",RCRPR T("typRprt ")="P":"Ph armacy",1: "Both Medi cal&Pharma cy")
  16465   "RTN","RCD PESPA",47, 0)
  16466    ;
  16467   "RTN","RCD PESPA",48, 0)
  16468    S Y("dtRa nge")=$$DT RNG() Q:Y( "dtRange") =0
  16469   "RTN","RCD PESPA",49, 0)
  16470    ;
  16471   "RTN","RCD PESPA",50, 0)
  16472    S RCRPRT( "begDate") =$P(Y("dtR ange"),U,2 ),RCRPRT(" endDate")= $P(Y("dtRa nge"),U,3)  K Y
  16473   "RTN","RCD PESPA",51, 0)
  16474    S RCRPRT( "eXcel")=$ $DISPTY^RC DPEM3() Q: +RCRPRT("e Xcel")=-1
  16475   "RTN","RCD PESPA",52, 0)
  16476    ; Display  capture i nformation  for Excel
  16477   "RTN","RCD PESPA",53, 0)
  16478    I RCRPRT( "eXcel") D  INFO^RCDP EM6
  16479   "RTN","RCD PESPA",54, 0)
  16480    ;Select o utput devi ce
  16481   "RTN","RCD PESPA",55, 0)
  16482    S %ZIS="M " D ^%ZIS  Q:POP  U I O
  16483   "RTN","RCD PESPA",56, 0)
  16484    ;
  16485   "RTN","RCD PESPA",57, 0)
  16486    S RCRPRT( "hdrDate") =$$FMTE^XL FDT($$NOW^ XLFDT,"5S" )
  16487   "RTN","RCD PESPA",58, 0)
  16488    S RCRPRT( "dtRange") =$$FMTE^XL FDT(RCRPRT ("begDate" ),"5D")_"  - "_$$FMTE ^XLFDT(RCR PRT("endDa te"),"5D")
  16489   "RTN","RCD PESPA",59, 0)
  16490    ;
  16491   "RTN","RCD PESPA",60, 0)
  16492    S RCRPRT( "endDate") =RCRPRT("e ndDate")+. 5
  16493   "RTN","RCD PESPA",61, 0)
  16494    S RCSCR=" I ($P(^(0) ,U)'<"_RCR PRT("begDa te")_")&($ P(^(0),U)' >"_RCRPRT( "endDate") _")"
  16495   "RTN","RCD PESPA",62, 0)
  16496    S RCFLDS= "@;.04;.01 I;.07;.06; .03;.05I;. 02"
  16497   "RTN","RCD PESPA",63, 0)
  16498    D LIST^DI C(344.7,,R CFLDS,"P", ,,,,RCSCR, ,RCDIGET," RCDIERR")
  16499   "RTN","RCD PESPA",64, 0)
  16500    I $D(RCDI ERR) W !!, "FileMan e rror when  collecting  report da ta." D ASK ^RCDPEARL( ) Q
  16501   "RTN","RCD PESPA",65, 0)
  16502    ;
  16503   "RTN","RCD PESPA",66, 0)
  16504    ; No chan ges found  for date r ange
  16505   "RTN","RCD PESPA",67, 0)
  16506    I '$D(@RC DIGET@("DI LIST",1))  G RPTEND
  16507   "RTN","RCD PESPA",68, 0)
  16508     ; Get Au to-Decreas e paramete rs
  16509   "RTN","RCD PESPA",69, 0)
  16510    S RCRPRT( "medAuto") =$P($G(^RC Y(344.61,1 ,0)),U,3)   ;(#.03) A UTO-DECREA SE MED ENA BLED [3S]
  16511   "RTN","RCD PESPA",70, 0)
  16512    S RCRPRT( "rxAuto")= $P($G(^RCY (344.61,1, 1)),U,2)   ; (#1.02)  AUTO-DECRE ASE RX ENA BLED [2S]
  16513   "RTN","RCD PESPA",71, 0)
  16514    ; Loop th ough chang es from #3 44.7
  16515   "RTN","RCD PESPA",72, 0)
  16516    S RCIEN=0  F  S RCIE N=$O(@RCDI GET@("DILI ST",RCIEN) ) Q:RCSTOP !'RCIEN  D
  16517   "RTN","RCD PESPA",73, 0)
  16518    . I 'RCRP RT("hdrPg# ") D HDRLP R(.RCRPRT, .RCSTOP) S  RCRPRT("p gLns")=9
  16519   "RTN","RCD PESPA",74, 0)
  16520    . Q:RCSTO P
  16521   "RTN","RCD PESPA",75, 0)
  16522    . K RCPAR AM S RCTMP =$P(@RCDIG ET@("DILIS T",RCIEN,0 ),U,2,8)
  16523   "RTN","RCD PESPA",76, 0)
  16524    . S RCPAR AM("file") =$P(RCTMP, U,6)
  16525   "RTN","RCD PESPA",77, 0)
  16526    . Q:RCPAR AM("file") =344.6  ;  Excluded p ayers repo rted elswh ere
  16527   "RTN","RCD PESPA",78, 0)
  16528    . S RCPAR AM("fld")= $P(RCTMP,U ) ; PRCA*4 .5*326
  16529   "RTN","RCD PESPA",79, 0)
  16530    . S RCPAR AM("oldVal ")=$P(RCTM P,U,3)
  16531   "RTN","RCD PESPA",80, 0)
  16532    . S RCPAR AM("newVal ")=$P(RCTM P,U,4)
  16533   "RTN","RCD PESPA",81, 0)
  16534    . ; store  labels in  ^TMP to a void redun dant FileM an calls
  16535   "RTN","RCD PESPA",82, 0)
  16536    . D:'$D(^ TMP($J,"RC LABEL",RCP ARAM("file "),RCPARAM ("fld")))
  16537   "RTN","RCD PESPA",83, 0)
  16538    ..  S ^TM P($J,"RCLA BEL",RCPAR AM("file") ,RCPARAM(" fld"))=$$G ET1^DID(RC PARAM("fil e"),RCPARA M("fld"),, "LABEL")
  16539   "RTN","RCD PESPA",84, 0)
  16540    . S RCPAR AM=^TMP($J ,"RCLABEL" ,RCPARAM(" file"),RCP ARAM("fld" ))
  16541   "RTN","RCD PESPA",85, 0)
  16542    . Q:'$$TY PMTCH(.RCR PRT,RCPARA M)
  16543   "RTN","RCD PESPA",86, 0)
  16544    . S RCRPR T("cntr")= RCRPRT("cn tr")+1  ;  count reco rds listed
  16545   "RTN","RCD PESPA",87, 0)
  16546    . I RCPAR AM("file") =344.61,RC PARAM("fld ")=.11 S R CPARAM="AU TO-DECREAS E MED NOPA Y ENABLED"   ; PRCA*4 .5*326
  16547   "RTN","RCD PESPA",88, 0)
  16548    . I RCPAR AM("file") =344.61,RC PARAM("fld ")=.12 S R CPARAM="AU TO-DECREAS E MED DAYS  (NO-PAY)"   ; PRCA*4 .5*326
  16549   "RTN","RCD PESPA",89, 0)
  16550    . S X=$P( RCTMP,U,2)   ; date&t ime
  16551   "RTN","RCD PESPA",90, 0)
  16552    . S RCPAR AM("dt&tm" )=$S(RCRPR T("eXcel") :$TR($$FMT E^XLFDT(X) ,"@"," "), 1:$$FMTE^X LFDT(X,"2S Z"))
  16553   "RTN","RCD PESPA",91, 0)
  16554    . S RCPAR AM("usr")= $P(RCTMP,U ,5),RCPARA M("oldVal" )=$P(RCTMP ,U,3),RCPA RAM("newVa l")=$P(RCT MP,U,4)
  16555   "RTN","RCD PESPA",92, 0)
  16556    . ; Next  line - add ed EDI cla im auto-de crease no- pay parame ter field  .08 - PRCA *4.5*326
  16557   "RTN","RCD PESPA",93, 0)
  16558    . I (RCPA RAM("fld") =.02)!(RCP ARAM("fld" )=1.01)!(R CPARAM("fl d")=.08) D
  16559   "RTN","RCD PESPA",94, 0)
  16560    ..  I RCP ARAM("file ")=344.62  S RCPARAM= RCPARAM_"  ("_$S($P(R CTMP,U,7)' ="":$P($G( ^RCY(RCPAR AM("file") ,$P(RCTMP, U,7),0)),U ,1),1:"ERR ")_")"
  16561   "RTN","RCD PESPA",95, 0)
  16562    ..  S RCP ARAM("oldV al")=$S(+$ P(RCTMP,U, 3)=0:"No", +$P(RCTMP, U,3)=1:"Ye s",1:"Err" )
  16563   "RTN","RCD PESPA",96, 0)
  16564    ..  S RCP ARAM("newV al")=$S(+$ P(RCTMP,U, 4)=0:"No", +$P(RCTMP, U,4)=1:"Ye s",1:"Err" )
  16565   "RTN","RCD PESPA",97, 0)
  16566    . ; Next  line - add ed EDI cla im auto-au dit parame ter fields  - PRCA*4. 5*321
  16567   "RTN","RCD PESPA",98, 0)
  16568    . I (RCPA RAM("fld") =.03)!(RCP ARAM("fld" )=.11)!(RC PARAM("fld ")=7.05)!( RCPARAM("f ld")=7.06) !(RCPARAM( "fld")=7.0 7)!(RCPARA M("fld")=7 .08)!(RCPA RAM("fld") =7.09) D
  16569   "RTN","RCD PESPA",99, 0)
  16570    ..  S RCP ARAM("oldV al")=$S($P (RCTMP,U,3 ):"Yes",1: "No")
  16571   "RTN","RCD PESPA",100 ,0)
  16572    ..  S RCP ARAM("newV al")=$S($P (RCTMP,U,4 ):"Yes",1: "No")
  16573   "RTN","RCD PESPA",101 ,0)
  16574    . ; Next  line - add ed EDI cla im auto-de crease no- pay parame ter field  .12 - PRCA *4.5*326
  16575   "RTN","RCD PESPA",102 ,0)
  16576    . I (RCPA RAM("file" )=344.62)& ((RCPARAM( "fld")=.12 )!(RCPARAM ("fld")=.0 6)) D
  16577   "RTN","RCD PESPA",103 ,0)
  16578    ..  S RCP ARAM=RCPAR AM_" ("_$S ($P(RCTMP, U,7)'="":$ P($G(^RCY( RCPARAM("f ile"),$P(R CTMP,U,7), 0)),U,1),1 :"ERR")_") "
  16579   "RTN","RCD PESPA",104 ,0)
  16580    . ; if nu ll set to  hyphen
  16581   "RTN","RCD PESPA",105 ,0)
  16582    . F X="ol dVal","new Val" S:'$L (RCPARAM(X )) RCPARAM (X)="-"
  16583   "RTN","RCD PESPA",106 ,0)
  16584    . I 'RCRP RT("eXcel" ) D
  16585   "RTN","RCD PESPA",107 ,0)
  16586    ..  S Y=$ $PAD(RCPAR AM,33)_$$P AD(RCPARAM ("dt&tm"), 19)_$$PAD( RCPARAM("o ldVal"),5) _$$PAD(RCP ARAM("newV al"),5)_RC PARAM("usr ")
  16587   "RTN","RCD PESPA",108 ,0)
  16588    ..  W !,$ E(Y,1,IOM)  S RCRPRT( "pgLns")=R CRPRT("pgL ns")+1
  16589   "RTN","RCD PESPA",109 ,0)
  16590    ..  I '(R CRPRT("pgL ns")<(IOSL -2)) D HDR LPR(.RCRPR T,.RCSTOP)  Q:RCSTOP   S RCRPRT( "pgLns")=9
  16591   "RTN","RCD PESPA",110 ,0)
  16592    . I RCRPR T("eXcel")  W !,RCPAR AM_U_RCPAR AM("dt&tm" )_U_RCPARA M("oldVal" )_U_RCPARA M("newVal" )_U_RCPARA M("usr")
  16593   "RTN","RCD PESPA",111 ,0)
  16594    ;
  16595   "RTN","RCD PESPA",112 ,0)
  16596   RPTEND ; e nd of repo rt
  16597   "RTN","RCD PESPA",113 ,0)
  16598    I 'RCSTOP ,'RCRPRT(" cntr") D
  16599   "RTN","RCD PESPA",114 ,0)
  16600    . D HDRLP R(.RCRPRT, .RCSTOP)
  16601   "RTN","RCD PESPA",115 ,0)
  16602    . W !," *  No PARAME TER AUDIT  entries to  report. * ",!
  16603   "RTN","RCD PESPA",116 ,0)
  16604    ;
  16605   "RTN","RCD PESPA",117 ,0)
  16606    I 'RCSTOP  W !!,$$EN DORPRT^RCD PEARL,!
  16607   "RTN","RCD PESPA",118 ,0)
  16608    U IO(0) D  ^%ZISC
  16609   "RTN","RCD PESPA",119 ,0)
  16610    I 'RCSTOP ,'$G(ZTSK) ,($E(IOST, 1,2)="C-")  D  ; must  have user
  16611   "RTN","RCD PESPA",120 ,0)
  16612    . N DIR,D IROUT,DIRU T,DTOUT,DU OUT,X,Y
  16613   "RTN","RCD PESPA",121 ,0)
  16614    . S DIR(" A")="Press  enter to  continue:  "
  16615   "RTN","RCD PESPA",122 ,0)
  16616    . S DIR(0 )="EA" D ^ DIR
  16617   "RTN","RCD PESPA",123 ,0)
  16618    ;
  16619   "RTN","RCD PESPA",124 ,0)
  16620    K @RCDIGE T,^TMP($J, "RCLABEL")   ; clean  up
  16621   "RTN","RCD PESPA",125 ,0)
  16622    ;
  16623   "RTN","RCD PESPA",126 ,0)
  16624    Q
  16625   "RTN","RCD PESPA",127 ,0)
  16626    ;
  16627   "RTN","RCD PESPA",128 ,0)
  16628   HDRLPR(RCR PRT,RCSTOP ) ; Report  header Lo ckbox Para meter Repo rt
  16629   "RTN","RCD PESPA",129 ,0)
  16630    ;   RCRPR T("eXcel")  - if true  output fo r Excel
  16631   "RTN","RCD PESPA",130 ,0)
  16632    ;   RCRPR T("hdrPg#" ) - page c ount, pass ed by ref.
  16633   "RTN","RCD PESPA",131 ,0)
  16634    ;   RCSTO P  - repor t exit fla g
  16635   "RTN","RCD PESPA",132 ,0)
  16636    ;   RCRPR T("typRprt ")  - Type  of report  to run
  16637   "RTN","RCD PESPA",133 ,0)
  16638    ;
  16639   "RTN","RCD PESPA",134 ,0)
  16640    I RCRPRT( "eXcel") D   Q  ; Exc el header  for PARAME TER AUDITS
  16641   "RTN","RCD PESPA",135 ,0)
  16642    . Q:RCRPR T("hdrPg#" )
  16643   "RTN","RCD PESPA",136 ,0)
  16644    . W !,"PA RAMETER^DA TE/TIME ED ITED^OLD V ALUE^NEW V ALUE^USER"
  16645   "RTN","RCD PESPA",137 ,0)
  16646    . S RCRPR T("hdrPg#" )=1  ; onl y print on ce
  16647   "RTN","RCD PESPA",138 ,0)
  16648    ;
  16649   "RTN","RCD PESPA",139 ,0)
  16650    I 'RCRPRT ("eXcel")  D
  16651   "RTN","RCD PESPA",140 ,0)
  16652    . I RCRPR T("hdrPg#" ) D ASK^RC DPEARL(.RC STOP) Q:RC STOP
  16653   "RTN","RCD PESPA",141 ,0)
  16654    . W @IOF
  16655   "RTN","RCD PESPA",142 ,0)
  16656    . S RCRPR T("hdrPg#" )=RCRPRT(" hdrPg#")+1
  16657   "RTN","RCD PESPA",143 ,0)
  16658    . W $$CNT R("EDI Loc kbox Param eter Audit  Report"), ?IOM-8,"Pa ge: "_RCRP RT("hdrPg# ")
  16659   "RTN","RCD PESPA",144 ,0)
  16660    . W !,$$C NTR("RUN D ATE: "_RCR PRT("hdrDa te"))
  16661   "RTN","RCD PESPA",145 ,0)
  16662    . W !,$$C NTR("DATE  RANGE: "_R CRPRT("dtR ange"))
  16663   "RTN","RCD PESPA",146 ,0)
  16664    . W !,$$C NTR("REPOR T TYPE: "_ RCRPRT("hd rTyp"))
  16665   "RTN","RCD PESPA",147 ,0)
  16666    . W !!,"L OCKBOX PAR AMETER UPD ATES"
  16667   "RTN","RCD PESPA",148 ,0)
  16668    . W !,"-- ---------- ---------- ----                              Values"
  16669   "RTN","RCD PESPA",149 ,0)
  16670    . W !,"Pa rameter                           Date/Time  Edited    Old  New   User"
  16671   "RTN","RCD PESPA",150 ,0)
  16672    . W !,$TR ($J("",IOM -1)," ","= ")  ; row  of equal s igns
  16673   "RTN","RCD PESPA",151 ,0)
  16674    Q
  16675   "RTN","RCD PESPA",152 ,0)
  16676    ;
  16677   "RTN","RCD PESPA",153 ,0)
  16678   GETPAYER()  ; GET THE  PAYER NAM E + PAYER  ID
  16679   "RTN","RCD PESPA",154 ,0)
  16680    N RCIEN,R CPAYR
  16681   "RTN","RCD PESPA",155 ,0)
  16682    S RCIEN=$ P(RCTMP,U, 6)
  16683   "RTN","RCD PESPA",156 ,0)
  16684    I '$D(^RC Y(344.6,RC IEN)) Q ""
  16685   "RTN","RCD PESPA",157 ,0)
  16686    S RCPAYR= $$GET1^DIQ (344.6,RCI EN_",",.01 )_" "_$$GE T1^DIQ(344 .6,RCIEN_" ,",.02)
  16687   "RTN","RCD PESPA",158 ,0)
  16688    Q RCPAYR
  16689   "RTN","RCD PESPA",159 ,0)
  16690    ;
  16691   "RTN","RCD PESPA",160 ,0)
  16692    ;
  16693   "RTN","RCD PESPA",161 ,0)
  16694   CNTR(TXT)  ; center T XT
  16695   "RTN","RCD PESPA",162 ,0)
  16696    Q $J("",I OM-$L(TXT) \2)_TXT
  16697   "RTN","RCD PESPA",163 ,0)
  16698    ;
  16699   "RTN","RCD PESPA",164 ,0)
  16700   DTRNG() ;  function,  returns da te range f or the rep ort
  16701   "RTN","RCD PESPA",165 ,0)
  16702    N RCEND,R CSTART
  16703   "RTN","RCD PESPA",166 ,0)
  16704    D DATES(. RCSTART,.R CEND)
  16705   "RTN","RCD PESPA",167 ,0)
  16706    Q:RCSTART =-1 0
  16707   "RTN","RCD PESPA",168 ,0)
  16708    Q:RCSTART  "1^"_RCST ART_"^"_RC END
  16709   "RTN","RCD PESPA",169 ,0)
  16710    Q:'RCSTAR T "0^^"
  16711   "RTN","RCD PESPA",170 ,0)
  16712    Q 0
  16713   "RTN","RCD PESPA",171 ,0)
  16714    ;
  16715   "RTN","RCD PESPA",172 ,0)
  16716   DATES(BDAT E,EDATE) ;  Get a dat e range, b oth values  passed by  ref.
  16717   "RTN","RCD PESPA",173 ,0)
  16718    N DIR,DTO UT,DUOUT,X ,Y
  16719   "RTN","RCD PESPA",174 ,0)
  16720    S (BDATE, EDATE)=0
  16721   "RTN","RCD PESPA",175 ,0)
  16722    S DIR("?" )="Enter t he earlies t AUDIT DA TE to incl ude on the  report"
  16723   "RTN","RCD PESPA",176 ,0)
  16724    S DIR(0)= "DAO^:"_DT _":APE",DI R("A")="Re port start  date: " D  ^DIR K DI R
  16725   "RTN","RCD PESPA",177 ,0)
  16726    I $D(DTOU T)!$D(DUOU T)!(Y="")  S BDATE=-1  Q
  16727   "RTN","RCD PESPA",178 ,0)
  16728    S BDATE=Y  K DIR,X,Y
  16729   "RTN","RCD PESPA",179 ,0)
  16730    S DIR("?" )="Enter t he latest  AUDIT DATE  to includ e on the r eport"
  16731   "RTN","RCD PESPA",180 ,0)
  16732    S DIR(0)= "DAO^"_BDA TE_":"_DT_ ":APE",DIR ("A")="Rep ort end da te: ",DIR( "B")=$$FMT E^XLFDT(DT )
  16733   "RTN","RCD PESPA",181 ,0)
  16734    D ^DIR K  DIR
  16735   "RTN","RCD PESPA",182 ,0)
  16736    I $D(DTOU T)!$D(DUOU T)!(Y="")  S BDATE=-1  Q
  16737   "RTN","RCD PESPA",183 ,0)
  16738    S EDATE=Y
  16739   "RTN","RCD PESPA",184 ,0)
  16740    Q
  16741   "RTN","RCD PESPA",185 ,0)
  16742    ;
  16743   "RTN","RCD PESPA",186 ,0)
  16744   RTYPE(DEF)  ; type of  informati on to disp lay
  16745   "RTN","RCD PESPA",187 ,0)
  16746    ; Input:    DEF - de fault valu e
  16747   "RTN","RCD PESPA",188 ,0)
  16748    ; Returns :
  16749   "RTN","RCD PESPA",189 ,0)
  16750    ; M - Med ical, P -  Pharmacy,  B - Both,  -1  - ^ or  timed out
  16751   "RTN","RCD PESPA",190 ,0)
  16752    N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT
  16753   "RTN","RCD PESPA",191 ,0)
  16754    S DIR("?" )="Enter t he type of  informati on to disp lay on the  report."
  16755   "RTN","RCD PESPA",192 ,0)
  16756    S DIR(0)= "SA^M:Medi cal;P:Phar macy;B:Bot h"
  16757   "RTN","RCD PESPA",193 ,0)
  16758    S DIR("A" )="(M)edic al, (P)har macy, B(ot h): "
  16759   "RTN","RCD PESPA",194 ,0)
  16760    S DIR("B" )=$S($G(DE F)'="":DEF ,1:"Both")
  16761   "RTN","RCD PESPA",195 ,0)
  16762    D ^DIR
  16763   "RTN","RCD PESPA",196 ,0)
  16764    K DIR
  16765   "RTN","RCD PESPA",197 ,0)
  16766    I $D(DTOU T)!$D(DUOU T) Q -1
  16767   "RTN","RCD PESPA",198 ,0)
  16768    S:Y="" Y= "A"
  16769   "RTN","RCD PESPA",199 ,0)
  16770    Q $E(Y)
  16771   "RTN","RCD PESPA",200 ,0)
  16772    ; 
  16773   "RTN","RCD PESPA",201 ,0)
  16774   TYPMTCH(RC RPRT,RCPAR AM) ; Bool ean functi on, does v alue match  report ty pe?
  16775   "RTN","RCD PESPA",202 ,0)
  16776    ; Return  1 if valid  to print,  else zero
  16777   "RTN","RCD PESPA",203 ,0)
  16778    Q:RCRPRT( "typRprt") ="B" 1  ;  both types
  16779   "RTN","RCD PESPA",204 ,0)
  16780    Q:RCPARAM ["TRIC" 1   ; Tricare  change, o n both rep orts
  16781   "RTN","RCD PESPA",205 ,0)
  16782    ;
  16783   "RTN","RCD PESPA",206 ,0)
  16784    Q:(RCRPRT ("typRprt" )="M")&(RC PARAM["MED ") 1  ; Me dical Para meters
  16785   "RTN","RCD PESPA",207 ,0)
  16786    Q:(RCRPRT ("typRprt" )="P")&((R CPARAM["RX ")!(RCPARA M["PHARM") ) 1  ; Pha rmacy para meters
  16787   "RTN","RCD PESPA",208 ,0)
  16788    ; evaluat e if auto- decrease o n
  16789   "RTN","RCD PESPA",209 ,0)
  16790    ; RCRPRT( "medAuto")  and RCRPR T("rxAuto" ) carried  in symbol  table
  16791   "RTN","RCD PESPA",210 ,0)
  16792    Q:(RCRPRT ("typRprt" )="M")&($G (RCRPRT("m edAuto"))) &(RCPARAM[ "DECREASE" ) 1  ; Aut o-decrease  for med i s on
  16793   "RTN","RCD PESPA",211 ,0)
  16794    Q:(RCRPRT ("typRprt" )="P")&($G (RCRPRT("r xAuto")))& (RCPARAM[" DECREASE")  1   ; Aut o-decrease  for pharm acy
  16795   "RTN","RCD PESPA",212 ,0)
  16796    Q 0
  16797   "RTN","RCD PESPA",213 ,0)
  16798    ;
  16799   "RTN","RCD PESPA",214 ,0)
  16800   PAD(A,N) ;  pad A wit h N spaces
  16801   "RTN","RCD PESPA",215 ,0)
  16802    S A=A_" "  ; always  add 1 spac e
  16803   "RTN","RCD PESPA",216 ,0)
  16804    Q:'($L(A) <N) A  ; n o padding  needed
  16805   "RTN","RCD PESPA",217 ,0)
  16806    Q A_$J("" ,N-$L(A))
  16807   "RTN","RCD PESPA",218 ,0)
  16808    ;
  16809   "RTN","RCD PESR2")
  16810   0^4^B93193 873
  16811   "RTN","RCD PESR2",1,0 )
  16812   RCDPESR2 ; ALB/TMK/DW A - Server  auto-upd  - EDI Lock box ;30 Ju ly 2018 20 :13:45
  16813   "RTN","RCD PESR2",2,0 )
  16814    ;;4.5;Acc ounts Rece ivable;**1 73,216,208 ,230,252,2 64,269,271 ,298,321,3 32**;Mar 2 0, 1995;Bu ild 34
  16815   "RTN","RCD PESR2",3,0 )
  16816    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  16817   "RTN","RCD PESR2",4,0 )
  16818    ; IA 4042  (IBCEOB)
  16819   "RTN","RCD PESR2",5,0 )
  16820    ;Referenc e to $$VAL ECME^BPSUT IL2 suppor ted by IA#  6139
  16821   "RTN","RCD PESR2",6,0 )
  16822    ;
  16823   "RTN","RCD PESR2",7,0 )
  16824   TASKERA(RC TDA) ; Tas k to upd E RA
  16825   "RTN","RCD PESR2",8,0 )
  16826    ; RCTDA =  ien 344.5
  16827   "RTN","RCD PESR2",9,0 )
  16828    N ZTDTH,Z TUCI,ZTSAV E,ZTIO,ZTD ESC,ZTRTN, ZTSK,DIE,D R,DA
  16829   "RTN","RCD PESR2",10, 0)
  16830    S (ZTSAVE ("DT"),ZTS AVE("U"),Z TSAVE("DUZ "))="",ZTS AVE("ZTREQ ")="@",ZTR TN="NEWERA ^RCDPESR2( "_RCTDA_", 0)",ZTDTH= $H,ZTIO=""
  16831   "RTN","RCD PESR2",11, 0)
  16832    D ^%ZTLOA D
  16833   "RTN","RCD PESR2",12, 0)
  16834    Q
  16835   "RTN","RCD PESR2",13, 0)
  16836    ;
  16837   "RTN","RCD PESR2",14, 0)
  16838   NEWERA(RCT DA,RCREFIL E) ;Tasked
  16839   "RTN","RCD PESR2",15, 0)
  16840    ; Add new  EOB's to  IB & ERA t ot rec to  AR
  16841   "RTN","RCD PESR2",16, 0)
  16842    ; RCTDA =  ien 344.5
  16843   "RTN","RCD PESR2",17, 0)
  16844    ; RCREFIL E = 1: re- filing rec  via exc p roc
  16845   "RTN","RCD PESR2",18, 0)
  16846    N DA,DIE, DR,Q,RCADJ ,RCDUPERR, RCE,RCEC,R CERR,RCNEW TRC,RCPAYE R,RCR1,RCR TOT,Z
  16847   "RTN","RCD PESR2",19, 0)
  16848    S ZTREQ=" @"
  16849   "RTN","RCD PESR2",20, 0)
  16850    K ^TMP($J ,"RCDPERA" )
  16851   "RTN","RCD PESR2",21, 0)
  16852    L +^RCY(3 44.5,RCTDA ):5
  16853   "RTN","RCD PESR2",22, 0)
  16854    I $D(ZTQU EUED) S DI E="^RCY(34 4.5,",DA=R CTDA,DR=". 05////"_ZT SK_";.04// //1" D ^DI E
  16855   "RTN","RCD PESR2",23, 0)
  16856    I $P($G(^ RCY(344.5, RCTDA,0)), U,5),'$G(R CREFILE) S  DIE="^RCY (344.5,",D A=RCTDA,DR =".1////4; .08///1" D  ^DIE
  16857   "RTN","RCD PESR2",24, 0)
  16858    S RCR1=$P ($G(^RCY(3 44.5,RCTDA ,0)),U,7), RCPAYER=$P ($G(^RCY(3 44.5,RCTDA ,3)),U)
  16859   "RTN","RCD PESR2",25, 0)
  16860    S RCRTOT= $S(RCR1:RC R1,1:$$ERA TOT^RCDPES R6(RCTDA,. RCERR)) ;  ERA rec
  16861   "RTN","RCD PESR2",26, 0)
  16862    S RCDUPER R=$S($G(RC ERR)="DUP" !($G(RCERR (1))=-2):$ G(RCERR(1) ),1:0) K R CERR(1)
  16863   "RTN","RCD PESR2",27, 0)
  16864    I RCRTOT, 'RCR1 S DI E="^RCY(34 4.5,",DR=" .07////"_R CRTOT,DA=R CTDA D ^DI E
  16865   "RTN","RCD PESR2",28, 0)
  16866    D:RCDUPER R'=-2 UPDE OB(RCTDA,5 ,$S('$G(RC REFILE):RC DUPERR,1:- 1)) ; Add  EOB det to  IB
  16867   "RTN","RCD PESR2",29, 0)
  16868    I RCRTOT  D UPDCON^R CDPESR6(RC RTOT),UPDA DJ^RCDPESR 6(RCRTOT), UPD3444^RC DPESR6(.RC RTOT) ; Bi lls added  344.41
  16869   "RTN","RCD PESR2",30, 0)
  16870    I RCRTOT, RCTDA S DI E="^RCY(34 4.5,",DR=" .08////0;. 1///@",DA= RCTDA D ^D IE
  16871   "RTN","RCD PESR2",31, 0)
  16872    I 'RCRTOT  D  G QNEW
  16873   "RTN","RCD PESR2",32, 0)
  16874    . I RCDUP ERR Q:'RCT DA  D  S R CTDA="" Q
  16875   "RTN","RCD PESR2",33, 0)
  16876    . . ;PRCA *4.5*332 -  27 July 2 018
  16877   "RTN","RCD PESR2",34, 0)
  16878    . . S DIE ="^RCY(344 .5,",DA=RC TDA,DR=".1 5///1" D ^ DIE
  16879   "RTN","RCD PESR2",35, 0)
  16880    . . L -^R CY(344.5,R CTDA)
  16881   "RTN","RCD PESR2",36, 0)
  16882    . . ;PRCA *4.5*332 e nd
  16883   "RTN","RCD PESR2",37, 0)
  16884    . S RCE(1 )=$$FMTE^X LFDT($$NOW ^XLFDT(),2 )_" An err or occurre d while st oring ERA  data.",RCE (2)="No to tals data  was stored  for this  ERA record "_$S('$G(R CREFILE):"  and an",1 :" on this  re-file a ttempt.")
  16885   "RTN","RCD PESR2",38, 0)
  16886    . S RCE(3 )=$S('$G(R CREFILE):" ERA transm ission exc eption was  created." ,1:"")
  16887   "RTN","RCD PESR2",39, 0)
  16888    . D WP^DI E(344.5,RC TDA_",",5, "A","RCE")
  16889   "RTN","RCD PESR2",40, 0)
  16890    . S DIE=" ^RCY(344.5 ,",DA=RCTD A,DR=".07/ //@;.08/// /1;.1////1 " D ^DIE
  16891   "RTN","RCD PESR2",41, 0)
  16892    . K RCERR
  16893   "RTN","RCD PESR2",42, 0)
  16894    . S RCERR (1)=$$FMTE ^XLFDT($$N OW^XLFDT() ,2)_" The  ERA data c ould not b e stored.  The AR rec eipt",RCER R(2)=" for  this data  must be c reated/pro cessed man ually for  the bills  included"
  16895   "RTN","RCD PESR2",43, 0)
  16896    . S RCERR (3)=" in t his ERA."_ $S('$G(RCR EFILE):"", 1:"  This  error occu rred durin g a refile  attempt." ),RCERR(4) =" "
  16897   "RTN","RCD PESR2",44, 0)
  16898    . D BULLE RA^RCDPESR 0("DF",RCT DA,$P($G(^ RCY(344.5, RCTDA,0)), U,11),"EDI  LBOX - TO TALS FILE  EXCEPTION  "_$E(RCPAY ER,1,20),. RCERR,0)
  16899   "RTN","RCD PESR2",45, 0)
  16900    . K RCERR
  16901   "RTN","RCD PESR2",46, 0)
  16902    ;
  16903   "RTN","RCD PESR2",47, 0)
  16904    ; PRCA*4. 5*298 - Ma ilMan mess age disabl ed, logic  retained -  14 Feb 20 14
  16905   "RTN","RCD PESR2",48, 0)
  16906    ;I $$ADJ^ RCDPEU(RCR TOT,.RCADJ ) D  ;Bull etin adjs
  16907   "RTN","RCD PESR2",49, 0)
  16908    ;.S RCEC= $$ADJERR^R CDPESR3(.R CERR)
  16909   "RTN","RCD PESR2",50, 0)
  16910    ;.I RCADJ '=2 S RCEC =RCEC+1,RC ERR(RCEC)= " THERE AR E ERA LEVE L ADJUSTME NT(S)",RCE C=RCEC+1,R CERR(RCEC) =" "
  16911   "RTN","RCD PESR2",51, 0)
  16912    ;.I RCADJ '=1 S RCEC =RCEC+1,RC ERR(RCEC)= " THE FOLL OWING BILL (S) HAVE R ETRACTIONS :" D
  16913   "RTN","RCD PESR2",52, 0)
  16914    ;..S (Q,Z )=0 S Z=0  F  S Z=$O( RCADJ(RCRT OT,Z)) Q:' Z  S:'Q RC EC=RCEC+1, RCERR(RCEC )="  " S Q =Q+1,RCERR (RCEC)=RCE RR(RCEC)_"   "_RCADJ( RCRTOT,Z)  S:Q=4 Q=0
  16915   "RTN","RCD PESR2",53, 0)
  16916    ;..S RCEC =RCEC+1,RC ERR(RCEC)= " "
  16917   "RTN","RCD PESR2",54, 0)
  16918    ;.D BULLE RA^RCDPESR 0("D",RCTD A,$P($G(^R CY(344.5,R CTDA,0)),U ,11),"EDI  LBOX - ERA  HAS ADJ/T AKEBACKS " _$E(RCPAYE R,1,20),.R CERR,0)
  16919   "RTN","RCD PESR2",55, 0)
  16920    ;-----
  16921   "RTN","RCD PESR2",56, 0)
  16922    ;
  16923   "RTN","RCD PESR2",57, 0)
  16924   QNEW I RCT DA,'$P($G( ^RCY(344.5 ,RCTDA,0)) ,U,8) D TE MPDEL^RCDP ESR1(RCTDA ) S RCTDA= ""
  16925   "RTN","RCD PESR2",58, 0)
  16926    I RCTDA,$ P($G(^RCY( 344.5,RCTD A,0)),U)'= "" S DIE=" ^RCY(344.5 ,",DR=".04 ////0;.05/ //@"_$S('$ G(RCR1)&$G (RCRTOT):" ;.07////"_ RCRTOT,1:" "),DA=RCTD A D ^DIE
  16927   "RTN","RCD PESR2",59, 0)
  16928    K ^TMP($J ,"RCDPERA" )
  16929   "RTN","RCD PESR2",60, 0)
  16930    I RCTDA L  -^RCY(344 .5,RCTDA)
  16931   "RTN","RCD PESR2",61, 0)
  16932    Q
  16933   "RTN","RCD PESR2",62, 0)
  16934    ;
  16935   "RTN","RCD PESR2",63, 0)
  16936   UPDEOB(RCT DA,RCFILE, DUP) ;Upd  361.1 from  ERA msg i n 344.5 or  .4
  16937   "RTN","RCD PESR2",64, 0)
  16938    ;RCTDA =  ien ERA ms g in 344.5  or ;subfi le in 344. 4
  16939   "RTN","RCD PESR2",65, 0)
  16940    ;RCFILE =  4 file 34 4.4, 5 if  344.5
  16941   "RTN","RCD PESR2",66, 0)
  16942    ;DUP = ms g # if dup  msg, but  not same #  or -1 if  same msg #
  16943   "RTN","RCD PESR2",67, 0)
  16944    ;Returned  for each  bill in ER A:
  16945   "RTN","RCD PESR2",68, 0)
  16946    ;^TMP($J, "RCDPEOB", n)=Bill ie n^AR bill# ^SrvDt^ECM E#
  16947   "RTN","RCD PESR2",69, 0)
  16948    ;^TMP($J, "RCDPEOB", n,"EOB")=E OB ien^amt  pd^ins co  ptr^rev f lg^EEOB pn ^amtbld^^^ ^BPNPI^RNP I^ETQual^L N^FN
  16949   "RTN","RCD PESR2",70, 0)
  16950    ;^TMP($J, "RCDPEOB", "ADJ",x)=a dj rec ('0 2')
  16951   "RTN","RCD PESR2",71, 0)
  16952    ;Also:
  16953   "RTN","RCD PESR2",72, 0)
  16954    ;^TMP($J, "RCDPEOB", "HDR")=hdr  rec from  txmn
  16955   "RTN","RCD PESR2",73, 0)
  16956    ;^TMP($J, "RCDPEOB", "CONTACT") =ERA conta ct rec ('0 1')
  16957   "RTN","RCD PESR2",74, 0)
  16958    ;
  16959   "RTN","RCD PESR2",75, 0)
  16960    ;N RCGBL, RC,RC0,RCC T,RCCT1,RC EOB,RCBILL ,RCDPBNPI, RCMNUM,RCI FN,RCIB,RC ERR,RCSTAR ,RCET,RCX, RCXMG,Z,Q, DA,DR,DIE
  16961   "RTN","RCD PESR2",76, 0)
  16962    ;N RCPAYE R,RCFILED, RCEOBD,RCN OUPD,REFOR M,RCSD,RCE RR1,C5,ECM ENUM
  16963   "RTN","RCD PESR2",77, 0)
  16964    ; PRCA*4. 5*321 - re -ordered n ewed field s and adde d RCSTART
  16965   "RTN","RCD PESR2",78, 0)
  16966    N C5,DA,D IE,DR,ECME NUM,N,Q,RC ,RC0,RCBIL L,RCCT,RCC T1,RCDPBNP I,RCEOB,RC EOBD,RCERR
  16967   "RTN","RCD PESR2",79, 0)
  16968    N RCERR1, RCET,RCFIL ED,RCGBL,R CIB,RCIFN, RCMNUM,RCN OUPD,RCPAY ER,RCSD,RC STAR,RCSTA RT
  16969   "RTN","RCD PESR2",80, 0)
  16970    N RCX,RCX MG,REFORM, X,Y,Z
  16971   "RTN","RCD PESR2",81, 0)
  16972    K ^TMP($J ,"RCDP-EOB "),^TMP("R CDPERR-EOB ",$J)
  16973   "RTN","RCD PESR2",82, 0)
  16974    ;
  16975   "RTN","RCD PESR2",83, 0)
  16976    S RCPAYER ="",RCFILE D=1,RCNOUP D=0
  16977   "RTN","RCD PESR2",84, 0)
  16978    I RCFILE= 5 D
  16979   "RTN","RCD PESR2",85, 0)
  16980    .S RCGBL= $NA(^RCY(3 44.5,RCTDA ,2))
  16981   "RTN","RCD PESR2",86, 0)
  16982    .S RCMNUM =+$G(^RCY( 344.5,RCTD A,0)),RCXM G=$P($G(^( 0)),U,11)
  16983   "RTN","RCD PESR2",87, 0)
  16984    .I $G(DUP ) S RCNOUP D=$S(DUP>0 :+DUP,1:RC XMG)
  16985   "RTN","RCD PESR2",88, 0)
  16986    .S ^TMP($ J,"RCDPEOB ","HDR")=$ G(^RCY(344 .5,RCTDA,2 ,1,0))
  16987   "RTN","RCD PESR2",89, 0)
  16988    .I $G(RCN EWTRC)'=""  S $P(^TMP ($J,"RCDPE OB","HDR") ,U,8)=RCNE WTRC ; PRC A*4.5*332  Update EEO B with -DU P trace#
  16989   "RTN","RCD PESR2",90, 0)
  16990    .I $P(^TM P($J,"RCDP EOB","HDR" ),U)["XFR" ,'$P($G(^R CY(344.5,R CTDA,0)),U ,14) D
  16991   "RTN","RCD PESR2",91, 0)
  16992    ..D SENDA CK^RCDPESR 5(RCTDA,1)
  16993   "RTN","RCD PESR2",92, 0)
  16994    ..S DR=". 14////1",D IE="^RCY(3 44.5,",DA= RCTDA D ^D IE
  16995   "RTN","RCD PESR2",93, 0)
  16996    ;
  16997   "RTN","RCD PESR2",94, 0)
  16998    I RCFILE= 4 D
  16999   "RTN","RCD PESR2",95, 0)
  17000    .S RCGBL= $NA(^RCY(3 44.4,+RCTD A,1,+$P(RC TDA,";",2) ,1))
  17001   "RTN","RCD PESR2",96, 0)
  17002    .S RCMNUM =$P($G(^RC Y(344.4,+R CTDA,0)),U ,12),RCXMG =$P($G(^(0 )),U,12)
  17003   "RTN","RCD PESR2",97, 0)
  17004    .S ^TMP($ J,"RCDPEOB ","HDR")=$ G(^RCY(344 .4,+RCTDA, 1,+$P(RCTD A,";",2),1 ,1,0))
  17005   "RTN","RCD PESR2",98, 0)
  17006    ;
  17007   "RTN","RCD PESR2",99, 0)
  17008    S RCPAYER =$P($G(^TM P($J,"RCDP EOB","HDR" )),U,6)
  17009   "RTN","RCD PESR2",100 ,0)
  17010    S RCDPBNP I=$P($G(^T MP($J,"RCD PEOB","HDR ")),U,18)
  17011   "RTN","RCD PESR2",101 ,0)
  17012    ;
  17013   "RTN","RCD PESR2",102 ,0)
  17014    ;srv date s
  17015   "RTN","RCD PESR2",103 ,0)
  17016    S RCSD=$N A(^TMP($J, "RCSRVDT") ) K @RCSD
  17017   "RTN","RCD PESR2",104 ,0)
  17018    S RCSTART =0 ; PRCA* 4.5*321
  17019   "RTN","RCD PESR2",105 ,0)
  17020    N CP5 S C P5="",RC=1 ,C5=0 ;ret rofit 264  into 269
  17021   "RTN","RCD PESR2",106 ,0)
  17022    F  S RC=$ O(@RCGBL@( RC)) Q:'RC   S RC0=$G (^(RC,0))  D
  17023   "RTN","RCD PESR2",107 ,0)
  17024    .I RC0<5  Q
  17025   "RTN","RCD PESR2",108 ,0)
  17026    .;Stateme nt Start D ate - 05 R ecord is m andatory
  17027   "RTN","RCD PESR2",109 ,0)
  17028    .I +RC0=5  S RCSTART =+$P(RC0,U ,9) ; PRCA *4.5*321
  17029   "RTN","RCD PESR2",110 ,0)
  17030    .I +RC0=5  S C5=RC,C P5=$P(RC0, U,2) Q  ;r etrofit 26 4 into 269
  17031   "RTN","RCD PESR2",111 ,0)
  17032    .; servic e date for  possible  ECME# matc hing
  17033   "RTN","RCD PESR2",112 ,0)
  17034    .; PRCA*4 .3*321 BEG IN
  17035   "RTN","RCD PESR2",113 ,0)
  17036    .I +RC0=4 0,$$VALECM E^BPSUTIL2 (CP5),C5,' $D(@RCSD@( C5)) D
  17037   "RTN","RCD PESR2",114 ,0)
  17038    . I $P(RC 0,U,19) S  @RCSD@(C5) =+$P(RC0,U ,19) Q
  17039   "RTN","RCD PESR2",115 ,0)
  17040    . ; If se rvice date  not prese nt use sta tement sta rt date in stead
  17041   "RTN","RCD PESR2",116 ,0)
  17042    . S:RCSTA RT @RCSD@( C5)=RCSTAR T
  17043   "RTN","RCD PESR2",117 ,0)
  17044    ; PRCA*4. 5*321 END
  17045   "RTN","RCD PESR2",118 ,0)
  17046    ;
  17047   "RTN","RCD PESR2",119 ,0)
  17048    S RC=1,(R CCT,RCCT1, RCX,REFORM )=0,RCBILL =""
  17049   "RTN","RCD PESR2",120 ,0)
  17050    S RCERR1= $NA(^TMP(" RCERR1",$J )) K @RCER R1
  17051   "RTN","RCD PESR2",121 ,0)
  17052    F  S RC=$ O(@RCGBL@( RC)) Q:'RC   S RC0=$G (^(RC,0))  D
  17053   "RTN","RCD PESR2",122 ,0)
  17054    .I RCFILE =5,+RC0=1  D  Q
  17055   "RTN","RCD PESR2",123 ,0)
  17056    ..S ^TMP( $J,"RCDPEO B","CONTAC T")=RC0
  17057   "RTN","RCD PESR2",124 ,0)
  17058    .;
  17059   "RTN","RCD PESR2",125 ,0)
  17060    .I RCFILE =5,+RC0=2  D  Q
  17061   "RTN","RCD PESR2",126 ,0)
  17062    ..S RCX=R CX+1,^TMP( $J,"RCDPEO B","ADJ",R CX)=RC0
  17063   "RTN","RCD PESR2",127 ,0)
  17064    .I RCFILE =5,+RC0=3  D  Q  ; Ad ding logic  for line  type 03,Pa tch 269,DW A
  17065   "RTN","RCD PESR2",128 ,0)
  17066    ..S $P(^T MP($J,"RCD PEOB","ADJ ",RCX),U,5 )=$P(RC0,U ,2)
  17067   "RTN","RCD PESR2",129 ,0)
  17068    .;
  17069   "RTN","RCD PESR2",130 ,0)
  17070    .I +RC0=5  S RCCT=RC CT+1,RCCT1 =0 D
  17071   "RTN","RCD PESR2",131 ,0)
  17072    ..S REFOR M=0,ECMENU M="" I $$V ALECME^BPS UTIL2($P(R C0,U,2)) S  ECMENUM=$ P(RC0,U,2)
  17073   "RTN","RCD PESR2",132 ,0)
  17074    ..S Z=$$B ILL^RCDPES R1($P(RC0, U,2),$G(@R CSD@(RC)), .RCIB)   ;  look up c laim ien b y claim# o r by ECME#
  17075   "RTN","RCD PESR2",133 ,0)
  17076    ..I Z S R CBILL=$P($ G(^PRCA(43 0,Z,0)),U)  I RCBILL' ="",RCBILL '=$P(RC0,U ,2) S REFO RM=1,$P(RC 0,U,2)=RCB ILL
  17077   "RTN","RCD PESR2",134 ,0)
  17078    ..S RCBIL L=$P(RC0,U ,2)
  17079   "RTN","RCD PESR2",135 ,0)
  17080    ..S Z=$S( Z>0:$S($G( RCIB):Z,1: -1),1:-1)
  17081   "RTN","RCD PESR2",136 ,0)
  17082    ..S ^TMP( $J,"RCDP-E OB",RCCT,0 )=Z_U_RCBI LL_U_$G(@R CSD@(RC))_ U_ECMENUM
  17083   "RTN","RCD PESR2",137 ,0)
  17084    ..S $P(^T MP($J,"RCD PEOB",RCCT ,"EOB"),U, 5)=$P(RC0, U,3)_","_$ P(RC0,U,4) _" "_$P(RC 0,U,5) ;Sa ve pt nm
  17085   "RTN","RCD PESR2",138 ,0)
  17086    ..I Z>0 S  Q=+$P($G( ^PRCA(430, Z,0)),U,9)  I $P($G(^ RCD(340,Q, 0)),U)["DI C(36," S $ P(^TMP($J, "RCDPEOB", RCCT,"EOB" ),U,3)=+^R CD(340,Q,0 ) ;Save in s co
  17087   "RTN","RCD PESR2",139 ,0)
  17088    .;
  17089   "RTN","RCD PESR2",140 ,0)
  17090    .I +RC0>5 ,REFORM S  $P(RC0,U,2 )=RCBILL ;
  17091   "RTN","RCD PESR2",141 ,0)
  17092    .I +RC0=1 0 D  ;Save  amt pd/bi lled, rev  flg
  17093   "RTN","RCD PESR2",142 ,0)
  17094    ..S $P(^T MP($J,"RCD PEOB",RCCT ,"EOB"),U, 2)=$S(+$P( RC0,U,11): $J($P(RC0, U,11)/100, "",2),1:0) ,$P(^TMP($ J,"RCDPEOB ",RCCT,"EO B"),U,6)=$ J($P(RC0,U ,11),"",2)
  17095   "RTN","RCD PESR2",143 ,0)
  17096    ..I $P(RC 0,U,6)="Y" !($P(RC0,U ,7)=22) S  $P(^TMP($J ,"RCDPEOB" ,RCCT,"EOB "),U,4)=1
  17097   "RTN","RCD PESR2",144 ,0)
  17098    ..S $P(^T MP($J,"RCD PEOB",RCCT ,"EOB"),U, 10,14)=RCD PBNPI_U_$P (RC0,U,16, 19)
  17099   "RTN","RCD PESR2",145 ,0)
  17100    .I +RC0=1 1 D  ; Sav e Renderin g Provider  informati on from ne w style me ssage
  17101   "RTN","RCD PESR2",146 ,0)
  17102    ..S $P(^T MP($J,"RCD PEOB",RCCT ,"EOB"),U, 10,14)=RCD PBNPI_U_$P (RC0,U,3,6 )
  17103   "RTN","RCD PESR2",147 ,0)
  17104    ..; End s ave of Ren dering Pro vider
  17105   "RTN","RCD PESR2",148 ,0)
  17106    .I RCBILL =$P(RC0,U, 2) S RCCT1 =RCCT1+1,^ TMP($J,"RC DP-EOB",RC CT,RCCT1,0 )=RC0
  17107   "RTN","RCD PESR2",149 ,0)
  17108    ;
  17109   "RTN","RCD PESR2",150 ,0)
  17110    S RCSTAR= $TR($J("", 15)," ","* "),RCET=RC STAR_"ERRO R/WARNING  EEOB DETAI L SEQ #"
  17111   "RTN","RCD PESR2",151 ,0)
  17112    S RCCT=0  F  S RCCT= $O(^TMP($J ,"RCDP-EOB ",RCCT)) Q :'RCCT  S  RCIFN=+$G( ^(RCCT,0)) ,RCBILL=$P ($G(^(0)), U,2),^TMP( $J,"RCDPEO B",RCCT)=$ G(^TMP($J, "RCDP-EOB" ,RCCT,0))  D
  17113   "RTN","RCD PESR2",152 ,0)
  17114    .S RCEOB= -1,RCEOBD= ""
  17115   "RTN","RCD PESR2",153 ,0)
  17116    .I $S(RCI FN>0:$P(^P RCA(430.3, +$P($G(^PR CA(430,+RC IFN,0)),U, 8),0),U,3) '=102,RCIF N'>0&($G(D UP)'>0):1, 1:0) D
  17117   "RTN","RCD PESR2",154 ,0)
  17118    ..S @RCER R1@(RCCT)= " ",@RCERR 1@(RCCT,1) =RCET_RCCT _RCSTAR
  17119   "RTN","RCD PESR2",155 ,0)
  17120    ..S @RCER R1@(RCCT,2 )="Bill "_ RCBILL_" i s"_$S(RCIF N>0:" not  in an ACTI VE status  in your A/ R",1:"n't  valid/wasn 't found s o its deta il wasn't  stored in  IB")
  17121   "RTN","RCD PESR2",156 ,0)
  17122    ..S:RCFIL E=5 @RCERR 1@(RCCT,"* ")=@RCERR1 @(RCCT,2)
  17123   "RTN","RCD PESR2",157 ,0)
  17124    ..S @RCER R1@(RCCT,3 )="  The r eported am ount paid  on this bi ll was: "_ $P(^TMP($J ,"RCDPEOB" ,RCCT,"EOB "),U,2)
  17125   "RTN","RCD PESR2",158 ,0)
  17126    ..I RCIFN '>0 D
  17127   "RTN","RCD PESR2",159 ,0)
  17128    ...S @RCE RR1@(RCCT, 4)="  If t he bill is  not for y our site,  it must be  transferr ed to the"
  17129   "RTN","RCD PESR2",160 ,0)
  17130    ...S @RCE RR1@(RCCT, 5)="   cor rect site  and manual ly adjuste d in your  AR."
  17131   "RTN","RCD PESR2",161 ,0)
  17132    ...S @RCE RR1@(RCCT, 6)="  You  can perfor m this tra nsfer usin g EDI Lock box ERA/EE OB excepti on process ."
  17133   "RTN","RCD PESR2",162 ,0)
  17134    ...S @RCE RR1@(RCCT, 7)=" "
  17135   "RTN","RCD PESR2",163 ,0)
  17136    ..D DISP1 ^RCDPESR5( RCCT,1)
  17137   "RTN","RCD PESR2",164 ,0)
  17138    ..S Q=0 F   S Q=$O(^ TMP($J,"RC DP-EOB",RC CT,Q)) Q:' Q  S ^TMP( $J,"RCDPEO B",RCCT,Q) =$G(^TMP($ J,"RCDP-EO B",RCCT,Q, 0))
  17139   "RTN","RCD PESR2",165 ,0)
  17140    ..S ^TMP( $J,"RCDPEO B",RCCT)=^ TMP($J,"RC DP-EOB",RC CT,0) M ^T MP($J,"RCD PEOB",RCCT ,"ERR")=@R CERR1@(RCC T)
  17141   "RTN","RCD PESR2",166 ,0)
  17142    ..I RCFIL E=5 D  ;St ore err if  trans-in  failed
  17143   "RTN","RCD PESR2",167 ,0)
  17144    ...N RCE, RC,DIE,X,Y ,DA,DR
  17145   "RTN","RCD PESR2",168 ,0)
  17146    ...S RCE( 1)=$$FMTE^ XLFDT($$NO W^XLFDT(), 2)_" "_$G( @RCERR1@(R CCT,"*"))
  17147   "RTN","RCD PESR2",169 ,0)
  17148    ...S RCE( 2)=" ",RCF ILED=0
  17149   "RTN","RCD PESR2",170 ,0)
  17150    ...D WP^D IE(344.5,R CTDA_",",5 ,"A","RCE" )
  17151   "RTN","RCD PESR2",171 ,0)
  17152    .I RCIFN> 0 D
  17153   "RTN","RCD PESR2",172 ,0)
  17154    ..N RCDUP EOB,RCALLD UP
  17155   "RTN","RCD PESR2",173 ,0)
  17156    ..;Chk re c exists
  17157   "RTN","RCD PESR2",174 ,0)
  17158    ..S RCDUP EOB=0
  17159   "RTN","RCD PESR2",175 ,0)
  17160    ..S RCEOB =$$DUP^RCD PESR3(RCMN UM,RCIFN,$ P($G(^TMP( $J,"RCDPEO B",RCCT,"E OB")),U,2) ,$P($G(^TM P($J,"RCDP EOB",RCCT, "EOB")),U, 6)) ;Same  msg for up date?
  17161   "RTN","RCD PESR2",176 ,0)
  17162    ..I RCEOB ,$P(RCEOB, U,2) S RCE OB=0  ;If  chksum exi sts, let b elow check  it
  17163   "RTN","RCD PESR2",177 ,0)
  17164    ..S ^TMP( $J,"RCDP-E OB",RCCT,. 5,0)="835E RA" ;Neede d - checks um
  17165   "RTN","RCD PESR2",178 ,0)
  17166    ..S RCALL DUP=$$DUP^ IBCEOB("^T MP("_$J_", ""RCDP-EOB "","_RCCT_ ")",RCIFN)
  17167   "RTN","RCD PESR2",179 ,0)
  17168    ..I $S(RC ALLDUP:1,R CEOB:$G(DU P)'>0,1:0)  D
  17169   "RTN","RCD PESR2",180 ,0)
  17170    ...S RCDU PEOB=1
  17171   "RTN","RCD PESR2",181 ,0)
  17172    ...D DUPR EC^RCDPESR 6(RCET,RCC T,RCSTAR,R CFILE,RCAL LDUP,RCEOB ,RCBILL,.R CDUPEOB)
  17173   "RTN","RCD PESR2",182 ,0)
  17174    ...S:RCAL LDUP RCEOB D=RCALLDUP
  17175   "RTN","RCD PESR2",183 ,0)
  17176    ..;Add st ub to 361. 1
  17177   "RTN","RCD PESR2",184 ,0)
  17178    ..I 'RCDU PEOB S RCE OB=+$$ADD3 611^IBCEOB (RCMNUM,"" ,"",RCIFN, 1,"^TMP("_ $J_",""RCD P-EOB"","_ RCCT_")")  ;IA 4042
  17179   "RTN","RCD PESR2",185 ,0)
  17180    ..K ^TMP( $J,"RCDP-E OB",RCCT,. 5,0)
  17181   "RTN","RCD PESR2",186 ,0)
  17182    ..I RCEOB <0 D:$G(DU P)'>0  Q
  17183   "RTN","RCD PESR2",187 ,0)
  17184    ...S @RCE RR1@(RCCT) =" ",^(RCC T,1)=RCET_ RCCT_RCSTA R,RCFILED= 0
  17185   "RTN","RCD PESR2",188 ,0)
  17186    ...S @RCE RR1@(RCCT, 2)="Error  - EEOB det ail not ad ded to IB  for bill " _RCBILL,$P (^TMP($J," RCDPEOB",R CCT,"EOB") ,U)=""
  17187   "RTN","RCD PESR2",189 ,0)
  17188    ...S:RCFI LE=5 @RCER R1@(RCCT," *")=@RCERR 1@(RCCT,2)
  17189   "RTN","RCD PESR2",190 ,0)
  17190    ...D DISP 1^RCDPESR5 (RCCT,1)
  17191   "RTN","RCD PESR2",191 ,0)
  17192    ...S Q=0  F  S Q=$O( ^TMP($J,"R CDP-EOB",R CCT,Q)) Q: 'Q  S ^TMP ($J,"RCDPE OB",RCCT,Q )=$G(^TMP( $J,"RCDP-E OB",RCCT,Q ,0))
  17193   "RTN","RCD PESR2",192 ,0)
  17194    ...S ^TMP ($J,"RCDPE OB",RCCT)= ^TMP($J,"R CDP-EOB",R CCT,0) M ^ TMP($J,"RC DPEOB",RCC T,"ERR")=@ RCERR1@(RC CT)
  17195   "RTN","RCD PESR2",193 ,0)
  17196    ..;Upd 36 1.1, needs  ^TMP($J," RCDPEOB"," HDR" and $ J,"RCDP-EO B"
  17197   "RTN","RCD PESR2",194 ,0)
  17198    ..I RCDUP EOB'<0 S R CNOUPD=0 D  UPD3611^I BCEOB(RCEO B,RCCT,1)
  17199   "RTN","RCD PESR2",195 ,0)
  17200    ..;errors  in ^TMP(" RCDPERR-EO B",$J
  17201   "RTN","RCD PESR2",196 ,0)
  17202    ..I $O(^T MP("RCDPER R-EOB",$J, 0)) D ERRU PD^IBCEOB( RCEOB,"RCD PERR-EOB")
  17203   "RTN","RCD PESR2",197 ,0)
  17204    ..S $P(^T MP($J,"RCD PEOB",RCCT ,"EOB"),U) =$S('$G(RC EOBD):RCEO B,1:RCEOBD )
  17205   "RTN","RCD PESR2",198 ,0)
  17206    .K ^TMP(" RCDPERR-EO B",$J)
  17207   "RTN","RCD PESR2",199 ,0)
  17208    ;
  17209   "RTN","RCD PESR2",200 ,0)
  17210    I RCNOUPD  D DUPERA^ RCDPESR3($ G(DUP),RCN OUPD)
  17211   "RTN","RCD PESR2",201 ,0)
  17212    I $O(@RCE RR1@(""))  D BULLS^RC DPESR3(RCF ILE,RCTDA, $S(RCNOUPD :RCNOUPD,1 :$G(DUP)), $G(RCXMG))
  17213   "RTN","RCD PESR2",202 ,0)
  17214    K ^TMP("R CDPERR-EOB ",$J),^TMP ($J,"RCDP- EOB"),@RCE RR1,@RCSD
  17215   "RTN","RCD PESR2",203 ,0)
  17216    D CLEAN^D ILF
  17217   "RTN","RCD PESR2",204 ,0)
  17218    Q
  17219   "RTN","RCD PESR6")
  17220   0^6^B58967 910
  17221   "RTN","RCD PESR6",1,0 )
  17222   RCDPESR6 ; ALB/TMK/DW A - Server  auto-upda te file 34 4.4 - EDI  Lockbox ;8  Aug 2018  21:44:13
  17223   "RTN","RCD PESR6",2,0 )
  17224    ;;4.5;Acc ounts Rece ivable;**1 73,214,208 ,230,252,2 69,271,298 ,321,332** ;Mar 20, 1 995;Build  34
  17225   "RTN","RCD PESR6",3,0 )
  17226    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  17227   "RTN","RCD PESR6",4,0 )
  17228    ;
  17229   "RTN","RCD PESR6",5,0 )
  17230    ;Referenc e to $$VAL ECME^BPSUT IL2 suppor ted by IA#  6139
  17231   "RTN","RCD PESR6",6,0 )
  17232    ;
  17233   "RTN","RCD PESR6",7,0 )
  17234   UPD3444(RC RTOT) ; Ad d EOB deta il to list  in 344.41  for file  344.4 entr y RCRTOT
  17235   "RTN","RCD PESR6",8,0 )
  17236    ; If pass ed by refe rence, RCR TOT is ret urned = ""  if errors
  17237   "RTN","RCD PESR6",9,0 )
  17238    ;
  17239   "RTN","RCD PESR6",10, 0)
  17240    N DA,DD,D IC,DIK,DLA YGO,DO,DR, RC,RC1,RC2 ,RCCOM1,RC COM2,RCCT, RCDPNM,RCE OB,RCNPI1, RCNPI2,X,Y ,Z
  17241   "RTN","RCD PESR6",11, 0)
  17242    S RC=0 F   S RC=$O(^ TMP($J,"RC DPEOB",RC) ) Q:'RC  S  RC1=$G(^( RC)),RC2=$ G(^(RC,"EO B")),RCEOB =+RC2 D  Q :'RCRTOT
  17243   "RTN","RCD PESR6",12, 0)
  17244    . ; Updat e 344.41 w ith refere nce to thi s record i f it doesn 't already  exist
  17245   "RTN","RCD PESR6",13, 0)
  17246    . I RCEOB >0 Q:$D(^R CY(344.4,R CRTOT,1,"A C",RCEOB,R C))
  17247   "RTN","RCD PESR6",14, 0)
  17248    . I RCEOB '>0,$S($P( RC1,U,2)'= "":$D(^RCY (344.4,RCR TOT,1,"AD" ,$P(RC1,U, 2),RC)),1: 0) Q
  17249   "RTN","RCD PESR6",15, 0)
  17250    . ; Disre gard ECME  reject rel ated EEOBs ; ECME# ca n be 7 dig its or 12  digits
  17251   "RTN","RCD PESR6",16, 0)
  17252    . I RCEOB '>0,'$P(RC 2,U,2),$$V ALECME^BPS UTIL2($P(R C1,U,2)),$ $REJECT^IB NCPDPU($P( RC1,U,2),$ P(RC1,U,3) ) Q
  17253   "RTN","RCD PESR6",17, 0)
  17254    . ;
  17255   "RTN","RCD PESR6",18, 0)
  17256    . S DA(1) =RCRTOT,X= RC,DIC="^R CY(344.4," _DA(1)_",1 ,",DIC(0)= "L",DLAYGO =344.41
  17257   "RTN","RCD PESR6",19, 0)
  17258    . S DIC(" DR")=$S($G (RCEOB)>0: ".02////"_ RCEOB,1:". 05////"_$P (RC1,U,2)_ ";.07////1 ")
  17259   "RTN","RCD PESR6",20, 0)
  17260    . I $P(RC 2,U,2)'=""  S DIC("DR ")=DIC("DR ")_$S($L(D IC("DR")): ";",1:"")_ ".03///"_$ P(RC2,U,2)  ; amt
  17261   "RTN","RCD PESR6",21, 0)
  17262    . I $P(RC 2,U,3)'=""  S DIC("DR ")=DIC("DR ")_$S($L(D IC("DR")): ";",1:"")_ ".04////"_ $P(RC2,U,3 ) ; ins co
  17263   "RTN","RCD PESR6",22, 0)
  17264    . I $P(RC 2,U,4) S D IC("DR")=D IC("DR")_$ S($L(DIC(" DR")):";", 1:"")_".14 ////1" ; r eversal
  17265   "RTN","RCD PESR6",23, 0)
  17266    . I $P(RC 2,U,5)'=""  S DIC("DR ")=DIC("DR ")_$S($L(D IC("DR")): ";",1:"")_ ".15////^S  X=$E($P(R C2,U,5),1, 30)" ; Pat ient name
  17267   "RTN","RCD PESR6",24, 0)
  17268    . ; Proce ss Billing  Prov NPI,  Rendering /Servicing  NPI & nam e
  17269   "RTN","RCD PESR6",25, 0)
  17270    . S (RCCO M1,RCCOM2) =""
  17271   "RTN","RCD PESR6",26, 0)
  17272    . S RCNPI 1=$P(RC2,U ,10),RCNPI 2=$P(RC2,U ,11)
  17273   "RTN","RCD PESR6",27, 0)
  17274    . I RCNPI 1'="",'$$C HKDGT^XUSN PI(RCNPI1)  S RCCOM1= "The Billi ng Provide r NPI rece ived on th e 835 ("_$ E(RCNPI1,1 ,10)_") is  not a val id format. "
  17275   "RTN","RCD PESR6",28, 0)
  17276    . I RCNPI 2'="",'$$C HKDGT^XUSN PI(RCNPI2)  S RCCOM2= "The "_$S( $P(RC2,U,1 2)=1:"Rend ering",1:" Servicing" )_" NPI re ceived on  the 835 (" _$E(RCNPI2 ,1,10)_")  is not a v alid forma t."
  17277   "RTN","RCD PESR6",29, 0)
  17278    . I RCCOM 1="" S DIC ("DR")=DIC ("DR")_";. 18////^S X =$P(RC2,U, 10)"  ;Bil ling Provi der NPI
  17279   "RTN","RCD PESR6",30, 0)
  17280    . I RCCOM 2="" S DIC ("DR")=DIC ("DR")_";. 19////^S X =$P(RC2,U, 11)"  ;Ren dering Pro vider NPI
  17281   "RTN","RCD PESR6",31, 0)
  17282    . S RCDPN M=$P(RC2,U ,13) I $P( RC2,U,14)] "" S RCDPN M=RCDPNM_$ S(RCDPNM]" ":",",1:"" )_$P(RC2,U ,14)
  17283   "RTN","RCD PESR6",32, 0)
  17284    . S DIC(" DR")=DIC(" DR")_";.2/ ///^S X=$P (RC2,U,12) ;.21////^S  X=RCDPNM"   ; Entity  Type Qual ifier ^ La st name,Fi rst Name
  17285   "RTN","RCD PESR6",33, 0)
  17286    . S DIC(" DR")=DIC(" DR")_";.22 ////^S X=R CCOM1;.23/ ///^S X=RC COM2"  ;Co mment on B illing pro vider^comm ent on ren dering/ser vicing pro vider NPI
  17287   "RTN","RCD PESR6",34, 0)
  17288    . I $$VAL ECME^BPSUT IL2($P(RC1 ,U,4)) D
  17289   "RTN","RCD PESR6",35, 0)
  17290    .. S DIC( "DR")=DIC( "DR")_";.2 4////^S X= $P(RC1,U,4 )"  ;Add E CME number  (if valid ) PRCA*4.5 *298
  17291   "RTN","RCD PESR6",36, 0)
  17292    . D FILE^ DICN K DO, DD,DLAYGO, DIC,DIK
  17293   "RTN","RCD PESR6",37, 0)
  17294    . S RCCT= +Y
  17295   "RTN","RCD PESR6",38, 0)
  17296    . I RCCT< 0 D  Q
  17297   "RTN","RCD PESR6",39, 0)
  17298    .. S DA=R CRTOT,DIK= "^RCY(344. 4," D ^DIK
  17299   "RTN","RCD PESR6",40, 0)
  17300    .. S RCRT OT=0
  17301   "RTN","RCD PESR6",41, 0)
  17302    . ; If th ere is no  IB EOB rec ord, store  the raw d ata in 344 .411
  17303   "RTN","RCD PESR6",42, 0)
  17304    . I RC1'> 0!(RCEOB'> 0) D
  17305   "RTN","RCD PESR6",43, 0)
  17306    .. N RCDA TA,RCC,RCD A
  17307   "RTN","RCD PESR6",44, 0)
  17308    .. S RCC= 2,RCDATA(1 )=$G(^TMP( $J,"RCDPEO B","HDR"))
  17309   "RTN","RCD PESR6",45, 0)
  17310    .. ; PRCA *4.5*321 -  use RC in  place of  RCCT to al low for ga ps in ERA  sequence n umbers (du e to ECME  rejects)
  17311   "RTN","RCD PESR6",46, 0)
  17312    .. S Z=0  F  S Z=$O( ^TMP($J,"R CDPEOB",RC ,Z)) Q:'Z   S RCC=RCC +1,RCDATA( RCC)=$G(^T MP($J,"RCD PEOB",RC,Z ))
  17313   "RTN","RCD PESR6",47, 0)
  17314    .. S RCDA (1)=RCRTOT ,RCDA=RCCT
  17315   "RTN","RCD PESR6",48, 0)
  17316    .. D WP^D IE(344.41, $$IENS^DIL F(.RCDA),1 ,"A","RCDA TA")
  17317   "RTN","RCD PESR6",49, 0)
  17318    Q
  17319   "RTN","RCD PESR6",50, 0)
  17320    ;
  17321   "RTN","RCD PESR6",51, 0)
  17322    ; PRCA*4. 5*332 star t - 8 Augu st 2018
  17323   "RTN","RCD PESR6",52, 0)
  17324   ERATOT(RC3 445DA,RCER R) ;functi on, File E RA TOTAL r ec in 344. 4 from ent ry RC3445D A in 344.5
  17325   "RTN","RCD PESR6",53, 0)
  17326    ; RC3445D A = ien fi le 344.5
  17327   "RTN","RCD PESR6",54, 0)
  17328    ; Returns : NEW ien  file 344.4
  17329   "RTN","RCD PESR6",55, 0)
  17330    ;           RCERR if  passed by  reference , with err or text
  17331   "RTN","RCD PESR6",56, 0)
  17332    ;           RCERR(1) =duplicate d message
  17333   "RTN","RCD PESR6",57, 0)
  17334    N LPXREF, RCDA,RCDUP ,RCFORCE,R CRAW,RCTRA CE,RCX,X,Y
  17335   "RTN","RCD PESR6",58, 0)
  17336    S (RCERR, RCDA)=""   ; returned  values
  17337   "RTN","RCD PESR6",59, 0)
  17338    S RCRAW(0 )=$G(^RCY( 344.5,RC34 45DA,2,1,0 ))
  17339   "RTN","RCD PESR6",60, 0)
  17340    S RCRAW(" Type")=$P( RCRAW(0),U ),RCTRACE= $P(RCRAW(0 ),U,8),RCR AW("InsID" )=$P(RCRAW (0),U,7),R CRAW("Paye r")=$P(RCR AW(0),U,6) ,RCRAW("Me thod")=$P( RCRAW(0),U ,17)
  17341   "RTN","RCD PESR6",61, 0)
  17342    ; Need he ader recor d as first  entry in  field
  17343   "RTN","RCD PESR6",62, 0)
  17344    I RCRAW(" Type")'["8 35ERA" S R CERR="No h eader reco rd found i n message.   An EEOB  exception  record was  created"  G ERATOTQ
  17345   "RTN","RCD PESR6",63, 0)
  17346    ;
  17347   "RTN","RCD PESR6",64, 0)
  17348    S RCRAW(" Date")=$$F MDT^RCDPES R1($P(RCRA W(0),U,9)) ,RCRAW("Am ount")=$J( ($P(RCRAW( 0),U,10)/1 00),0,2)
  17349   "RTN","RCD PESR6",65, 0)
  17350    ;Elec ERA 's must ha ve a trace  # and an  ins co id
  17351   "RTN","RCD PESR6",66, 0)
  17352    I RCTRACE =""!(RCRAW ("InsID")= "") S RCER R="Trace #  or ins ID  missing o n ERA tran saction.   An EEOB ex ception re cord was c reated." G  ERATOTQ
  17353   "RTN","RCD PESR6",67, 0)
  17354    ; Make su re it's no t already  there
  17355   "RTN","RCD PESR6",68, 0)
  17356    S (RCDUP, LPXREF)=0
  17357   "RTN","RCD PESR6",69, 0)
  17358    F  S LPXR EF=$O(^RCY (344.4,"AT RIDUP",$$U P^XLFSTR(R CTRACE),$$ UP^XLFSTR( RCRAW("Ins ID")),LPXR EF)) Q:'LP XREF  D  Q :RCDUP
  17359   "RTN","RCD PESR6",70, 0)
  17360    . S LPXRE F(0)=$G(^R CY(344.4,L PXREF,0))
  17361   "RTN","RCD PESR6",71, 0)
  17362    . I $P(LP XREF(0),U, 4)=RCRAW(" Date"),+$P (LPXREF(0) ,U,5)=+RCR AW("Amount ") S RCDUP =1
  17363   "RTN","RCD PESR6",72, 0)
  17364    ; If ERA  has a rece ipt and is  being fil ed from Du plicate ER A Worklist  find a ne w
  17365   "RTN","RCD PESR6",73, 0)
  17366    ; unique  trace numb er for thi s payer/am ount/date  and overri de duplica te check
  17367   "RTN","RCD PESR6",74, 0)
  17368    S RCFORCE =+$$GET1^D IQ(344.5,R C3445DA_", ",.15,"I")   ;(#.15)  DUPLICATE  INDICATOR  [15S]
  17369   "RTN","RCD PESR6",75, 0)
  17370    I RCFORCE  D  ; crea te new tra ce #
  17371   "RTN","RCD PESR6",76, 0)
  17372    . N DPCNT R S X=$E(R CTRACE,1,4 5)_"-DUP"   ; 49 char s. max
  17373   "RTN","RCD PESR6",77, 0)
  17374    . ; start  with null , then add  numbers u ntil it's  unique
  17375   "RTN","RCD PESR6",78, 0)
  17376    . F DPCNT R="",1:1 Q :'$D(^RCY( 344.4,"ATR IDUP",$$UP ^XLFSTR(X_ DPCNTR),$$ UP^XLFSTR( RCRAW("Ins ID"))))
  17377   "RTN","RCD PESR6",79, 0)
  17378    . ; above : "ATRIDUP " x-ref is  TRACE NUM BER & INSU RANCE CO I D
  17379   "RTN","RCD PESR6",80, 0)
  17380    . S (RCTR ACE,RCNEWT RC)=X_DPCN TR
  17381   "RTN","RCD PESR6",81, 0)
  17382    ;
  17383   "RTN","RCD PESR6",82, 0)
  17384    I '$G(RCF ORCE),RCDU P,$P(LPXRE F(0),U,8)  D  G ERATO TQ ; Recei pt already  exists -  no update
  17385   "RTN","RCD PESR6",83, 0)
  17386    . S RCERR ="This is  a duplicat e ERA and  has alread y been pos ted",RCERR (1)=-2
  17387   "RTN","RCD PESR6",84, 0)
  17388    ;
  17389   "RTN","RCD PESR6",85, 0)
  17390    I '$G(RCF ORCE),RCDU P D  G ERA TOTQ  ; du plicate fo und
  17391   "RTN","RCD PESR6",86, 0)
  17392    . S RCERR ="DUP",RCE RR(1)=$S($ P(LPXREF(0 ),U,12)'=$ P($G(^RCY( 344.5,RC34 45DA,0)),U ,11):$P(LP XREF(0),U, 12),1:-1)  G ERATOTQ
  17393   "RTN","RCD PESR6",87, 0)
  17394    ;
  17395   "RTN","RCD PESR6",88, 0)
  17396    D  ; cont ext for Fi leMan vari ables
  17397   "RTN","RCD PESR6",89, 0)
  17398    . N DA,DD ,DIC,DIE,D IK,DLAYGO, DO,DR,X,Y
  17399   "RTN","RCD PESR6",90, 0)
  17400    . S RCX=$ O(^RCY(344 .4,$C(1)), -1)+1,X=0   ; create  new IEN
  17401   "RTN","RCD PESR6",91, 0)
  17402    . ; loop  until no e ntry found
  17403   "RTN","RCD PESR6",92, 0)
  17404    . F RCX=R CX:1 D:'$D (^RCY(344. 4,RCX))  Q :X
  17405   "RTN","RCD PESR6",93, 0)
  17406    ..  L +^R CY(344.4,R CX,0):1 E   Q  ; get  exclusive  access
  17407   "RTN","RCD PESR6",94, 0)
  17408    ..  S X=R CX  ; new  entry #
  17409   "RTN","RCD PESR6",95, 0)
  17410    . ; X fro m above wi ll be new  .01 field  value
  17411   "RTN","RCD PESR6",96, 0)
  17412    . S DIC(0 )="L",DIC= "^RCY(344. 4,",DLAYGO =344.4
  17413   "RTN","RCD PESR6",97, 0)
  17414    . S DIC(" DR")=".02/ ///"_RCTRA CE_";.03// //"_RCRAW( "InsID")_" ;.04////"_ RCRAW("Dat e")_";.05/ ///"_RCRAW ("Amount") _";.06//// "_$P(RCRAW (0),U,6)_" ;.09////0; .12////"_$ P($G(^RCY( 344.5,RC34 45DA,0)),U ,11)_";.07 ////"_$$NO W^XLFDT()_ ";.1////1"
  17415   "RTN","RCD PESR6",98, 0)
  17416    . I RCRAW ("Method") '="" S DIC ("DR")=DIC ("DR")_";. 15////"_RC RAW("Metho d")
  17417   "RTN","RCD PESR6",99, 0)
  17418    . D FILE^ DICN S RCD A=$S(Y<0:" ",1:+Y)  ;  new IEN i n 344.4
  17419   "RTN","RCD PESR6",100 ,0)
  17420    ; done fi ling, unlo ck
  17421   "RTN","RCD PESR6",101 ,0)
  17422    L -^RCY(3 44.4,RCX,0 )
  17423   "RTN","RCD PESR6",102 ,0)
  17424    I 'RCDA D
  17425   "RTN","RCD PESR6",103 ,0)
  17426    . S RCERR ="An error  was encou ntered tha t prevente d the addi ng of an E RA totals  record.  A n EEOB exc eption rec ord was cr eated."
  17427   "RTN","RCD PESR6",104 ,0)
  17428    ;
  17429   "RTN","RCD PESR6",105 ,0)
  17430   ERATOTQ ;  GOTO here  or fall th rough
  17431   "RTN","RCD PESR6",106 ,0)
  17432    Q RCDA  ;  return ne w IEN
  17433   "RTN","RCD PESR6",107 ,0)
  17434    ; PRCA*4. 5*332 end  - 8 August  2018
  17435   "RTN","RCD PESR6",108 ,0)
  17436    ;
  17437   "RTN","RCD PESR6",109 ,0)
  17438   UPDCON(RCR TOT) ; Add  contact i nformation  to file 3 44.4 for a n ERA
  17439   "RTN","RCD PESR6",110 ,0)
  17440    N DIE,DA, DR,Z,Q,X,Y ,A,TYPE
  17441   "RTN","RCD PESR6",111 ,0)
  17442    S Z=$G(^T MP($J,"RCD PEOB","CON TACT"))
  17443   "RTN","RCD PESR6",112 ,0)
  17444    Q:$TR($P( Z,U,3,9),U )=""
  17445   "RTN","RCD PESR6",113 ,0)
  17446    S DA=RCRT OT,DIE="^R CY(344.4," ,DR=""
  17447   "RTN","RCD PESR6",114 ,0)
  17448    ;
  17449   "RTN","RCD PESR6",115 ,0)
  17450    ; If old  format do
  17451   "RTN","RCD PESR6",116 ,0)
  17452    I +$P($G( ^TMP($J,"R CDPEOB","H DR")),U,16 )'>0 D
  17453   "RTN","RCD PESR6",117 ,0)
  17454    . F Q=2:1 :8 S DR=DR _$S(DR'="" :";3.0",1: "3.0")_(Q- 1)_"///"_$ S($P(Z,U,Q )="":"@",1 :"/"_$P(Z, U,Q))
  17455   "RTN","RCD PESR6",118 ,0)
  17456    ;
  17457   "RTN","RCD PESR6",119 ,0)
  17458    ; If new  format (50 10) do
  17459   "RTN","RCD PESR6",120 ,0)
  17460    I +$P($G( ^TMP($J,"R CDPEOB","H DR")),U,16 )>0 D
  17461   "RTN","RCD PESR6",121 ,0)
  17462    . N CNT S  CNT=0
  17463   "RTN","RCD PESR6",122 ,0)
  17464    . I $P(Z, U,2)'="" S  DR="3.01/ ///"_$P(Z, U,2)
  17465   "RTN","RCD PESR6",123 ,0)
  17466    .I $P(Z,U ,3)'="" S  DR=DR_$S(D R'="":";3. 02",1:"3.0 2")_"////" _$P(Z,U,3) _";3.03/// /TE",CNT=C NT+1
  17467   "RTN","RCD PESR6",124 ,0)
  17468    .I $P(Z,U ,4)'="" D
  17469   "RTN","RCD PESR6",125 ,0)
  17470    ..S:CNT=1  DR=DR_$S( DR'="":";3 .04",1:"3. 04")_"//// "_$P(Z,U,4 )_";3.05// //FX"
  17471   "RTN","RCD PESR6",126 ,0)
  17472    ..S:CNT=0  DR=DR_$S( DR'="":";3 .02",1:"3. 02")_"//// "_$P(Z,U,4 )_";3.03// //FX"
  17473   "RTN","RCD PESR6",127 ,0)
  17474    ..S CNT=C NT+1
  17475   "RTN","RCD PESR6",128 ,0)
  17476    .I $P(Z,U ,5)'="" D
  17477   "RTN","RCD PESR6",129 ,0)
  17478    ..S:CNT=2  DR=DR_$S( DR'="":";3 .06",1:"3. 06")_"//// "_$P(Z,U,5 )_";3.07// //EM"
  17479   "RTN","RCD PESR6",130 ,0)
  17480    ..S:CNT=1  DR=DR_$S( DR'="":";3 .04",1:"3. 04")_"//// "_$P(Z,U,5 )_";3.05// //EM"
  17481   "RTN","RCD PESR6",131 ,0)
  17482    ..S:CNT=0  DR=DR_$S( DR'="":";3 .02",1:"3. 02")_"//// "_$P(Z,U,5 )_";3.03// //EM"
  17483   "RTN","RCD PESR6",132 ,0)
  17484    . I $P(Z, U,6)'="" S  DR=DR_$S( DR'="":";5 .01",1:"5. 01")_"//// "_$P(Z,U,6 )
  17485   "RTN","RCD PESR6",133 ,0)
  17486    D ^DIE
  17487   "RTN","RCD PESR6",134 ,0)
  17488    Q
  17489   "RTN","RCD PESR6",135 ,0)
  17490    ;
  17491   "RTN","RCD PESR6",136 ,0)
  17492   UPDADJ(RCR TOT) ; Add  ERA level  adj data  to file 34 4.4
  17493   "RTN","RCD PESR6",137 ,0)
  17494    N Z,Z0,DA ,DIC,DLAYG O,DR,X,Y,D O,DD
  17495   "RTN","RCD PESR6",138 ,0)
  17496    ; Remove  any alread y there
  17497   "RTN","RCD PESR6",139 ,0)
  17498    S Z=0 F   S Z=$O(^RC Y(344.4,RC RTOT,2,Z))  Q:'Z  S D A(1)=RCRTO T,DA=Z D ^ DIK
  17499   "RTN","RCD PESR6",140 ,0)
  17500    ;
  17501   "RTN","RCD PESR6",141 ,0)
  17502    S Z=0 F   S Z=$O(^TM P($J,"RCDP EOB","ADJ" ,Z)) Q:'Z   S Z0=$G(^ (Z)) D
  17503   "RTN","RCD PESR6",142 ,0)
  17504    . S DIC(0 )="L",X=$P (Z0,U,3)_"  ",DA(1)=R CRTOT,DIC= "^RCY(344. 4,"_DA(1)_ ",2,",DIC( "DR")=$S($ P(Z0,U,2)' ="":".02// //"_$P(Z0, U,2),1:"")
  17505   "RTN","RCD PESR6",143 ,0)
  17506    . S DIC(" DR")=DIC(" DR")_$S(DI C("DR")'=" ":";",1:"" )_$S($P(Z0 ,U,4)'="": ".03////"_ $J(-$P(Z0, U,4)/100," ",2),1:"")
  17507   "RTN","RCD PESR6",144 ,0)
  17508    . S DIC(" DR")=DIC(" DR")_$S(DI C("DR")'=" ":";",1:"" )_$S($P(Z0 ,U,5)'="": ".04////"_ $P(Z0,U,5) ,1:""),DLA YGO=344.42
  17509   "RTN","RCD PESR6",145 ,0)
  17510    . S:$O(^R CY(344.4,R CRTOT,2,"B ",X,0)) X= """"_X_""" "
  17511   "RTN","RCD PESR6",146 ,0)
  17512    . D FILE^ DICN K DIC ,DO,DD
  17513   "RTN","RCD PESR6",147 ,0)
  17514    Q
  17515   "RTN","RCD PESR6",148 ,0)
  17516    ;
  17517   "RTN","RCD PESR6",149 ,0)
  17518   DUPREC(RCE T,RCCT,RCS TAR,RCFILE ,RCALLDUP, RCEOB,RCBI LL,RCDUPEO B) ; Overf low from R CDPESR2
  17519   "RTN","RCD PESR6",150 ,0)
  17520    S ^TMP("R CERR1",$J, RCCT)=" ", ^TMP("RCER R1",$J,RCC T,1)=RCET_ RCCT_RCSTA R
  17521   "RTN","RCD PESR6",151 ,0)
  17522    S ^TMP("R CERR1",$J, RCCT,2)="( Warning):  EEOB detai l already  filed for  "_RCBILL_"  - "_$S(RC ALLDUP:"Du plicate no t stored", 1:"EEOB up dated"),^T MP("RCERR1 ",$J,RCCT, 3)=" " S:R CFILE=5 ^T MP("RCERR1 ",$J,RCCT, "*")=^TMP( "RCERR1",$ J,RCCT,2)
  17523   "RTN","RCD PESR6",152 ,0)
  17524    I RCALLDU P S RCEOB= "",RCDUPEO B=-1 Q
  17525   "RTN","RCD PESR6",153 ,0)
  17526    S $P(^TMP ($J,"RCDPE OB",RCCT," EOB"),U)=R CEOB
  17527   "RTN","RCD PESR6",154 ,0)
  17528    Q
  17529   "RTN","RCD PESR6",155 ,0)
  17530    ;
  17531   "RTN","RCD PEU1")
  17532   0^17^B1218 93428
  17533   "RTN","RCD PEU1",1,0)
  17534   RCDPEU1 ;A ITC/CJE -  ELECTRONIC  PAYER UTI LITIES ;05 -NOV-02
  17535   "RTN","RCD PEU1",2,0)
  17536    ;;4.5;Acc ounts Rece ivable;**3 26,332**;M ar 20, 199 5;Build 34
  17537   "RTN","RCD PEU1",3,0)
  17538    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  17539   "RTN","RCD PEU1",4,0)
  17540    Q
  17541   "RTN","RCD PEU1",5,0)
  17542   SELPAY(PAR AM) ; EP
  17543   "RTN","RCD PEU1",6,0)
  17544    ; New all  purpose p ayer selec tion subro utine. Bas ed off fil e 344.6
  17545   "RTN","RCD PEU1",7,0)
  17546    ; Includi ng options  to includ e only giv en payer t ypes (Medi cal/Pharma cy/Tricare /All)
  17547   "RTN","RCD PEU1",8,0)
  17548    ; and to  filter sel ection to  include on ly payers  that have  entries in  file 344. 4 or 344.3 1
  17549   "RTN","RCD PEU1",9,0)
  17550    ; This su broutine m ay be used  to replac e all prev ious payer  seletion  prompts. 
  17551   "RTN","RCD PEU1",10,0 )
  17552    ; Input -  PARAM arr ay of para meters pas sed by ref erence
  17553   "RTN","RCD PEU1",11,0 )
  17554    ;          PARAM("TY PE") - Typ es of paye rs to incl ude in the  selection  (optional  defaults  to A)
  17555   "RTN","RCD PEU1",12,0 )
  17556    ;                            P  - Pharmacy , T - Tric are, M - M edical (ne ither P no r T), A -  All 
  17557   "RTN","RCD PEU1",13,0 )
  17558    ;          PARAM("FI LE") - Onl y include  payers tha t have ent ries on th e ERA or E FT file (o ptional)
  17559   "RTN","RCD PEU1",14,0 )
  17560    ;                            34 4.4 -  ERA , 344.31 -  EFT
  17561   "RTN","RCD PEU1",15,0 )
  17562    ;          PARAM("SR CH") - Sea rch by pay er name or  TIN (opti onal defau lts to N)
  17563   "RTN","RCD PEU1",16,0 )
  17564    ;                            N  - Payer Na me, T - TI
  17565   "RTN","RCD PEU1",17,0 )
  17566    ;          PARAM("SE LC") - Sec lect indiv idual paye rs, or ran ge of paye rs (option al default s to S)
  17567   "RTN","RCD PEU1",18,0 )
  17568    ;                            S  - Selected  payers, R  - Range o f payers
  17569   "RTN","RCD PEU1",19,0 )
  17570    ;          PARAM("DI CA") - Tex t that wil l be used  to prompt  the user ( optional)
  17571   "RTN","RCD PEU1",20,0 )
  17572    ;                           def aults to " Select pay er "_$S(PA RAM("SRCH" )="N":"nam e",1:"TIN" )
  17573   "RTN","RCD PEU1",21,0 )
  17574    ;
  17575   "RTN","RCD PEU1",22,0 )
  17576    ; Output  - ^TMP("RC DPEU1",$J, DNS     EN)=""
  17577   "RTN","RCD PEU1",23,0 )
  17578    ;            ^TMP("RCDP EU1",$J,"N ",NAME, DNS     EN)=""
  17579   "RTN","RCD PEU1",24,0 )
  17580    ;            ^TMP("RCDP EU1",$J,"T ",TIN, DNS     EN)=""
  17581   "RTN","RCD PEU1",25,0 )
  17582    ;           Where:
  17583   "RTN","RCD PEU1",26,0 )
  17584    ;                    DNS     EN = Inter nal entry  number of  the payer  from file  344.6
  17585   "RTN","RCD PEU1",27,0 )
  17586    ;                  N AME     =  Payer name , TIN = Pa yer TIN
  17587   "RTN","RCD PEU1",28,0 )
  17588    ;                  F LAG     =  Pharmacy o r Tricare  or Medical  flag base d on Pharm acy and Tr icare flag s from fil e 344.6
  17589   "RTN","RCD PEU1",29,0 )
  17590    ;                               T - has tr icare flag , P - has  pharmacy f lag, M - h as neither  T or P fl ag.
  17591   "RTN","RCD PEU1",30,0 )
  17592    ; 
  17593   "RTN","RCD PEU1",31,0 )
  17594    ; Returns  - 1 - Suc cess, -1 -  Abort
  17595   "RTN","RCD PEU1",32,0 )
  17596    ;
  17597   "RTN","RCD PEU1",33,0 )
  17598    N RCA,RET ,RETURN,QU IT
  17599   "RTN","RCD PEU1",34,0 )
  17600    ;
  17601   "RTN","RCD PEU1",35,0 )
  17602    D INIT
  17603   "RTN","RCD PEU1",36,0 )
  17604    S RETURN= 1
  17605   "RTN","RCD PEU1",37,0 )
  17606    ;
  17607   "RTN","RCD PEU1",38,0 )
  17608    S QUIT=0
  17609   "RTN","RCD PEU1",39,0 )
  17610    I PARAM(" SELC")="R"  D  ;
  17611   "RTN","RCD PEU1",40,0 )
  17612    . S RCA=" Select STA RT range f or payer n ames: "
  17613   "RTN","RCD PEU1",41,0 )
  17614    . F  S RE T=$$PROMPT (.PARAM,RC A) Q:(RET' =0)  D RME SS
  17615   "RTN","RCD PEU1",42,0 )
  17616    . I RET=- 1 S RETURN =-1 Q
  17617   "RTN","RCD PEU1",43,0 )
  17618    . S RCA=" Select END  range for  payer nam es: "
  17619   "RTN","RCD PEU1",44,0 )
  17620    . F  S RE T=$$PROMPT (.PARAM,RC A) Q:(RET' =0)  D RME SS
  17621   "RTN","RCD PEU1",45,0 )
  17622    . I RET=- 1 S RETURN =-1 Q
  17623   "RTN","RCD PEU1",46,0 )
  17624    . D EXPAN D
  17625   "RTN","RCD PEU1",47,0 )
  17626    ;
  17627   "RTN","RCD PEU1",48,0 )
  17628    I PARAM(" SELC")="S"  D  ;
  17629   "RTN","RCD PEU1",49,0 )
  17630    . S QUIT= 0
  17631   "RTN","RCD PEU1",50,0 )
  17632    . F  D  Q :QUIT  ;
  17633   "RTN","RCD PEU1",51,0 )
  17634    . . S RET =$$PROMPT( .PARAM,PAR AM("DICA") )
  17635   "RTN","RCD PEU1",52,0 )
  17636    . . I RET =-1 S RETU RN=-1,QUIT =1 Q
  17637   "RTN","RCD PEU1",53,0 )
  17638    . . I RET =0 D  ;
  17639   "RTN","RCD PEU1",54,0 )
  17640    . . . I $ D(^TMP("RC DPEU1",$J) ) S QUIT=1
  17641   "RTN","RCD PEU1",55,0 )
  17642    . . . E   D RMESS
  17643   "RTN","RCD PEU1",56,0 )
  17644    ;
  17645   "RTN","RCD PEU1",57,0 )
  17646    I RETURN= -1 D CLEAN  Q -1
  17647   "RTN","RCD PEU1",58,0 )
  17648    S RETURN= $S($D(^TMP ("RCDPEU1" ,$J)):1,1: -1)
  17649   "RTN","RCD PEU1",59,0 )
  17650    Q RETURN
  17651   "RTN","RCD PEU1",60,0 )
  17652    ;
  17653   "RTN","RCD PEU1",61,0 )
  17654   PROMPT(PAR AM,RCA) ;  Prompt for  a payer f rom file 3 44.6 with  various fi lter optio ns
  17655   "RTN","RCD PEU1",62,0 )
  17656    ; Input:  PARAM - ar ray of par ameters de fined in s ubroutine  SELPAY abo ve
  17657   "RTN","RCD PEU1",63,0 )
  17658    ; Output:  ^TMP("RCD PEU1",$J)  as defined  in subrou tine SELPA Y above
  17659   "RTN","RCD PEU1",64,0 )
  17660    ; Returns :  1 - Pay er selecte d
  17661   "RTN","RCD PEU1",65,0 )
  17662    ;            0 - No  payer sele cted
  17663   "RTN","RCD PEU1",66,0 )
  17664    ;           -1 - use r typed '^ ' or timed  out
  17665   "RTN","RCD PEU1",67,0 )
  17666    ;
  17667   "RTN","RCD PEU1",68,0 )
  17668    N DIC,DIR ,DIROUT,DI RUT,DTOUT, DUOUT,RETU RN,X,Y
  17669   "RTN","RCD PEU1",69,0 )
  17670    S RETURN= 1
  17671   "RTN","RCD PEU1",70,0 )
  17672    ;
  17673   "RTN","RCD PEU1",71,0 )
  17674    I PARAM(" SRCH")="N"  D  ; Sele ct payers  by name
  17675   "RTN","RCD PEU1",72,0 )
  17676    . S DIC=3 44.6
  17677   "RTN","RCD PEU1",73,0 )
  17678    . S DIC(0 )="QEA"
  17679   "RTN","RCD PEU1",74,0 )
  17680    . S DIC(" A")=RCA
  17681   "RTN","RCD PEU1",75,0 )
  17682    . S DIC(" S")="I $$C HKPAY^RCDP EU1(Y,"""_ PARAM("TYP E")_""","" "_PARAM("F ILE")_""") "
  17683   "RTN","RCD PEU1",76,0 )
  17684    . I PARAM ("SELC")=" R",$D(^TMP ("RCDPEU1" ,$J)) D        ; Choo sing secon d name of  a range
  17685   "RTN","RCD PEU1",77,0 )
  17686    . . S DIC ("S")=DIC( "S")_",$$C HKRNG^RCDP EU1(Y)"  ;  only offe r payer na mes that f ollow star t range 
  17687   "RTN","RCD PEU1",78,0 )
  17688    . D ^DIC
  17689   "RTN","RCD PEU1",79,0 )
  17690    . I $D(DT OUT)!$D(DU OUT) S RET URN=-1 Q
  17691   "RTN","RCD PEU1",80,0 )
  17692    . I Y=-1  S RETURN=0  Q
  17693   "RTN","RCD PEU1",81,0 )
  17694    . D ADDPA Y(+Y)
  17695   "RTN","RCD PEU1",82,0 )
  17696    ;
  17697   "RTN","RCD PEU1",83,0 )
  17698    I PARAM(" SRCH")="T"  D  ; Sele ct payers  by TIN
  17699   "RTN","RCD PEU1",84,0 )
  17700    . N RET
  17701   "RTN","RCD PEU1",85,0 )
  17702    . S DIR(" A")="Selec t Insuranc e Company  TIN"
  17703   "RTN","RCD PEU1",86,0 )
  17704    . S DIR(0 )="FO^1:30 "
  17705   "RTN","RCD PEU1",87,0 )
  17706    . S DIR(" ?")="Enter  the TIN o f the paye r or '??'  to list pa yers"
  17707   "RTN","RCD PEU1",88,0 )
  17708    . S DIR(" ??")="^D T LIST^RCDPE U1"
  17709   "RTN","RCD PEU1",89,0 )
  17710    . D ^DIR
  17711   "RTN","RCD PEU1",90,0 )
  17712    . I $D(DT OUT)!$D(DU OUT) S RET URN=-1 Q
  17713   "RTN","RCD PEU1",91,0 )
  17714    . I Y=""  S RETURN=0  Q
  17715   "RTN","RCD PEU1",92,0 )
  17716    . S RET=$ $SRCHTIN(Y ,.PARAM)
  17717   "RTN","RCD PEU1",93,0 )
  17718    . I RET=- 1 S RETURN =-1 Q
  17719   "RTN","RCD PEU1",94,0 )
  17720    . I RET'= "" D ADDTI N(RET)
  17721   "RTN","RCD PEU1",95,0 )
  17722    Q RETURN
  17723   "RTN","RCD PEU1",96,0 )
  17724    ;
  17725   "RTN","RCD PEU1",97,0 )
  17726   EXPAND ; E xpand rang e of payer  names giv en start a nd end poi nts.
  17727   "RTN","RCD PEU1",98,0 )
  17728    ; Input:  Start and  end points  of the ra nge in the  global ^T MP("RCDPEU 1",$J) doc umented in  SELPAY ab ove.
  17729   "RTN","RCD PEU1",99,0 )
  17730    ; Output:  More ennt ries in ^T MP("RCDPEU 1",$J), on e for each  matching  payer in t he range.
  17731   "RTN","RCD PEU1",100, 0)
  17732    N K1,NAME
  17733   "RTN","RCD PEU1",101, 0)
  17734    S NAME(1) =$O(^TMP(" RCDPEU1",$ J,"N",""))
  17735   "RTN","RCD PEU1",102, 0)
  17736    S NAME(2) =$O(^TMP(" RCDPEU1",$ J,"N",""), -1) ; Note  if user p icks same  name as st art and en d range 1= 2
  17737   "RTN","RCD PEU1",103, 0)
  17738    ;
  17739   "RTN","RCD PEU1",104, 0)
  17740    D EXPANDX (NAME(1))
  17741   "RTN","RCD PEU1",105, 0)
  17742    ;
  17743   "RTN","RCD PEU1",106, 0)
  17744    S K1=NAME (1)
  17745   "RTN","RCD PEU1",107, 0)
  17746    F  S K1=$ O(^RCY(344 .6,"B",K1) ) Q:K1=""! (K1]NAME(2 ))  D EXPA NDX(K1)
  17747   "RTN","RCD PEU1",108, 0)
  17748    Q
  17749   "RTN","RCD PEU1",109, 0)
  17750   EXPANDX(NA ME) ; Add  all payers  with the  same name  into the l ist
  17751   "RTN","RCD PEU1",110, 0)
  17752    ; Input:  NAME - Pay er Name
  17753   "RTN","RCD PEU1",111, 0)
  17754    ;         PARAM - In put parame ters
  17755   "RTN","RCD PEU1",112, 0)
  17756    ; Output:  ^TMP("RCD PEU1",$J)
  17757   "RTN","RCD PEU1",113, 0)
  17758    N PAYIEN
  17759   "RTN","RCD PEU1",114, 0)
  17760    S PAYIEN= ""
  17761   "RTN","RCD PEU1",115, 0)
  17762    F  S PAYI EN=$O(^RCY (344.6,"B" ,NAME,PAYI EN)) Q:PAY IEN=""  D   ;
  17763   "RTN","RCD PEU1",116, 0)
  17764    . I $$CHK PAY(PAYIEN ,PARAM("TY PE"),PARAM ("FILE"))  D ADDPAY(P AYIEN)
  17765   "RTN","RCD PEU1",117, 0)
  17766    Q
  17767   "RTN","RCD PEU1",118, 0)
  17768    ;
  17769   "RTN","RCD PEU1",119, 0)
  17770   ADDPAY(PAY IEN) ; Add  payer to  the output  array.
  17771   "RTN","RCD PEU1",120, 0)
  17772    ; Input -  PAYIEN =  Internal e ntry numbe r from fil e #344.6
  17773   "RTN","RCD PEU1",121, 0)
  17774    ; Output  - New entr ies in ^TM P("RCDPEU1 ",$J
  17775   "RTN","RCD PEU1",122, 0)
  17776    N NAME,TI N
  17777   "RTN","RCD PEU1",123, 0)
  17778    S ^TMP("R CDPEU1",$J ,PAYIEN)=" "
  17779   "RTN","RCD PEU1",124, 0)
  17780    S NAME=$$ GET1^DIQ(3 44.6,PAYIE N_",",.01, "E")
  17781   "RTN","RCD PEU1",125, 0)
  17782    S TIN=$$G ET1^DIQ(34 4.6,PAYIEN _",",.02," E")
  17783   "RTN","RCD PEU1",126, 0)
  17784    S ^TMP("R CDPEU1",$J ,"N",NAME, TIN,PAYIEN )=""
  17785   "RTN","RCD PEU1",127, 0)
  17786    S ^TMP("R CDPEU1",$J ,"T",TIN,N AME,PAYIEN )=""
  17787   "RTN","RCD PEU1",128, 0)
  17788    Q
  17789   "RTN","RCD PEU1",129, 0)
  17790   ADDTIN(TIN ) ; Add al l payers w ith TIN to  the outpu t array
  17791   "RTN","RCD PEU1",130, 0)
  17792    ; Input -  Payer Ide ntifer str ing (TIN)  matching o ne or more  entries i n file #34 4.6 
  17793   "RTN","RCD PEU1",131, 0)
  17794    N PAYIEN
  17795   "RTN","RCD PEU1",132, 0)
  17796    S PAYIEN= ""
  17797   "RTN","RCD PEU1",133, 0)
  17798    F  S PAYI EN=$O(^RCY (344.6,"C" ,TIN,PAYIE N)) Q:'PAY IEN  D  ;
  17799   "RTN","RCD PEU1",134, 0)
  17800    . D ADDPA Y(PAYIEN)
  17801   "RTN","RCD PEU1",135, 0)
  17802    Q
  17803   "RTN","RCD PEU1",136, 0)
  17804   SRCHTIN(RC X,PARAM) ;  Given use r input na rrow down  the TIN th at the use r wants
  17805   "RTN","RCD PEU1",137, 0)
  17806    ; Input:  RCX - User  input to  use in TIN  lookup.
  17807   "RTN","RCD PEU1",138, 0)
  17808    ;         PARAM - ar ray of inp ut paramet ers (see s ubroutine  SELPAY for  detailed  descriptio n)
  17809   "RTN","RCD PEU1",139, 0)
  17810    N CNT,COU NT,DIR,DTO UT,DUOUT,K 1,K2,K3,LI ST,QUIT,RE TURN,SPACE ,SX,X,Y
  17811   "RTN","RCD PEU1",140, 0)
  17812    I $D(^RCY (344.6,"C" ,RCX_" "))  D CHKTIN( RCX_" ",.P ARAM,.LIST )
  17813   "RTN","RCD PEU1",141, 0)
  17814    S K1=RCX_ " "
  17815   "RTN","RCD PEU1",142, 0)
  17816    F  S K1=$ O(^RCY(344 .6,"C",K1) ) Q:K1=""! ($E(K1,1,$ L(RCX))'=R CX)  D  ;
  17817   "RTN","RCD PEU1",143, 0)
  17818    . D CHKTI N(K1,.PARA M,.LIST)
  17819   "RTN","RCD PEU1",144, 0)
  17820    ;
  17821   "RTN","RCD PEU1",145, 0)
  17822    I '$D(LIS T) D  Q 0
  17823   "RTN","RCD PEU1",146, 0)
  17824    . W !,"No  matching  TIN found" ,!
  17825   "RTN","RCD PEU1",147, 0)
  17826    ;
  17827   "RTN","RCD PEU1",148, 0)
  17828    S COUNT=0 ,K1=""
  17829   "RTN","RCD PEU1",149, 0)
  17830    F  S K1=$ O(LIST("T" ,K1)) Q:K1 =""  D  ; 
  17831   "RTN","RCD PEU1",150, 0)
  17832    . S COUNT =COUNT+1
  17833   "RTN","RCD PEU1",151, 0)
  17834    . S LIST( COUNT)=K1
  17835   "RTN","RCD PEU1",152, 0)
  17836    ; Show re sults and  let user p ick a TIN  by sequenc e number o r TIN
  17837   "RTN","RCD PEU1",153, 0)
  17838    S (COUNT, K1,K2,K3,R ETURN)="", (CNT,QUIT, SX)=0
  17839   "RTN","RCD PEU1",154, 0)
  17840    F  S COUN T=$O(LIST( COUNT)) Q: 'COUNT  D   I QUIT Q
  17841   "RTN","RCD PEU1",155, 0)
  17842    . S CNT=C NT+1
  17843   "RTN","RCD PEU1",156, 0)
  17844    . W !,$J( COUNT_".", 4)_"  " S  SPACE=0
  17845   "RTN","RCD PEU1",157, 0)
  17846    . S K1=LI ST(COUNT)
  17847   "RTN","RCD PEU1",158, 0)
  17848    . F  S K2 =$O(LIST(" T",K1,K2))  Q:K2=""   D  I QUIT  Q
  17849   "RTN","RCD PEU1",159, 0)
  17850    . . I SPA CE W !,"       "
  17851   "RTN","RCD PEU1",160, 0)
  17852    . . W $E( K1_$J("",3 1),1,30)
  17853   "RTN","RCD PEU1",161, 0)
  17854    . . W $E( K2,1,42)
  17855   "RTN","RCD PEU1",162, 0)
  17856    . . I 'SP ACE S SPAC E=1
  17857   "RTN","RCD PEU1",163, 0)
  17858    S DIR(0)= "NO^1:"_CN T_":0"
  17859   "RTN","RCD PEU1",164, 0)
  17860    D ^DIR
  17861   "RTN","RCD PEU1",165, 0)
  17862    I $D(DTOU T)!$D(DUOU T) Q -1
  17863   "RTN","RCD PEU1",166, 0)
  17864    I Y S RET URN=LIST(Y )
  17865   "RTN","RCD PEU1",167, 0)
  17866    Q RETURN
  17867   "RTN","RCD PEU1",168, 0)
  17868    ;
  17869   "RTN","RCD PEU1",169, 0)
  17870   CHKPAY(PAY IEN,TYPE,F ILE) ; Che ck if paye r meets th e filter r equirement s
  17871   "RTN","RCD PEU1",170, 0)
  17872    ; Input:   PAYIEN -  Internal e ntry numbe r of the p ayer from  file 344.6
  17873   "RTN","RCD PEU1",171, 0)
  17874    ;          TYPE   -  M - Medica l, P - Pha rmacy, T-  Tricare, A  - All
  17875   "RTN","RCD PEU1",172, 0)
  17876    ;          FILE   -  344.4 - ER A, 344.31  EFT - Paye r must hav e entries  in the giv en file
  17877   "RTN","RCD PEU1",173, 0)
  17878    ; Return:  1 - Payer  matches t he filter  criteria,  otherwise  0.
  17879   "RTN","RCD PEU1",174, 0)
  17880    ;
  17881   "RTN","RCD PEU1",175, 0)
  17882    N NAME,FL AG,RETURN, TIN
  17883   "RTN","RCD PEU1",176, 0)
  17884    I TYPE="A ",FILE=""  Q 1
  17885   "RTN","RCD PEU1",177, 0)
  17886    ;
  17887   "RTN","RCD PEU1",178, 0)
  17888    S RETURN= 1
  17889   "RTN","RCD PEU1",179, 0)
  17890    I TYPE'=" A" D  I 'R ETURN Q 0
  17891   "RTN","RCD PEU1",180, 0)
  17892    . S RETUR N=$$CHKTYP E(PAYIEN,T YPE)
  17893   "RTN","RCD PEU1",181, 0)
  17894    ;
  17895   "RTN","RCD PEU1",182, 0)
  17896    I FILE D   I 'RETURN  Q 0
  17897   "RTN","RCD PEU1",183, 0)
  17898    . S NAME= $$GET1^DIQ (344.6,PAY IEN_",",.0 1,"I")
  17899   "RTN","RCD PEU1",184, 0)
  17900    . S TIN=$ $GET1^DIQ( 344.6,PAYI EN_",",.02 ,"I")
  17901   "RTN","RCD PEU1",185, 0)
  17902    . I '$D(^ RCY(FILE," APT",NAME, TIN)) S RE TURN=0
  17903   "RTN","RCD PEU1",186, 0)
  17904    Q 1
  17905   "RTN","RCD PEU1",187, 0)
  17906   CHKRNG(PAY IEN) ; Che ck if seco nd picked  payer name  follows t he first
  17907   "RTN","RCD PEU1",188, 0)
  17908    ; Input:  PAYIEN = I nternal en try number  of payer  from file  #344.6
  17909   "RTN","RCD PEU1",189, 0)
  17910    ;         ^TMP("RCDP EU1",$J gl obal array  contains  previously  picked pa yer
  17911   "RTN","RCD PEU1",190, 0)
  17912    ; Return:  1 - if PA YIEN's nam e follows  that of pa yer in ^TM P, otherwi se 0
  17913   "RTN","RCD PEU1",191, 0)
  17914    ;
  17915   "RTN","RCD PEU1",192, 0)
  17916    N NAME,RE TURN
  17917   "RTN","RCD PEU1",193, 0)
  17918    S RETURN= 0
  17919   "RTN","RCD PEU1",194, 0)
  17920    S NAME(1) =$O(^TMP(" RCDPEU1",$ J,"N",""))
  17921   "RTN","RCD PEU1",195, 0)
  17922    S NAME(2) =$$GET1^DI Q(344.6,PA YIEN_",",. 01,"E")
  17923   "RTN","RCD PEU1",196, 0)
  17924    I NAME(2) ]NAME(1)!( NAME(2)=NA ME(1)) S R ETURN=1
  17925   "RTN","RCD PEU1",197, 0)
  17926    Q RETURN
  17927   "RTN","RCD PEU1",198, 0)
  17928    ;
  17929   "RTN","RCD PEU1",199, 0)
  17930   CHKTIN(TIN ,PARAM,OUT ) ; Given  a TIN chec k filter c riteria an d add pass ing entrie s to the O UT array
  17931   "RTN","RCD PEU1",200, 0)
  17932    ; Input:  TIN = Paye r Identifi er string  that match es one or  more payer s in file  #344.6
  17933   "RTN","RCD PEU1",201, 0)
  17934    ;         PARAM = In put parame ter array.  See subro utine SELP AY for det ailed docu mentation
  17935   "RTN","RCD PEU1",202, 0)
  17936    ; Output:  OUT (pass ed by refe rence) arr ay of paye rs matchin g filter p arameters.  Sorted by  TIN then  NAME
  17937   "RTN","RCD PEU1",203, 0)
  17938    N PAYIEN
  17939   "RTN","RCD PEU1",204, 0)
  17940    S PAYIEN= ""
  17941   "RTN","RCD PEU1",205, 0)
  17942    F  S PAYI EN=$O(^RCY (344.6,"C" ,TIN,PAYIE N)) Q:PAYI EN=""  D   ;
  17943   "RTN","RCD PEU1",206, 0)
  17944    . I $$CHK PAY(PAYIEN ,PARAM("TY PE"),PARAM ("FILE"))  D  ;
  17945   "RTN","RCD PEU1",207, 0)
  17946    . . N PNA ME
  17947   "RTN","RCD PEU1",208, 0)
  17948    . . S PNA ME=$$GET1^ DIQ(344.6, PAYIEN_"," ,.01,"E")
  17949   "RTN","RCD PEU1",209, 0)
  17950    . . I PNA ME="" Q
  17951   "RTN","RCD PEU1",210, 0)
  17952    . . S OUT ("T",TIN,P NAME,PAYIE N)=""
  17953   "RTN","RCD PEU1",211, 0)
  17954    Q
  17955   "RTN","RCD PEU1",212, 0)
  17956   TLIST ; Li st TINS fo r user hel p.  Only T INS matchi ng filter  criteria a re display ed.
  17957   "RTN","RCD PEU1",213, 0)
  17958    N COUNT,P AYIEN,QUIT ,TIN
  17959   "RTN","RCD PEU1",214, 0)
  17960    S (QUIT,C OUNT)=0
  17961   "RTN","RCD PEU1",215, 0)
  17962    S TIN=""
  17963   "RTN","RCD PEU1",216, 0)
  17964    F  S TIN= $O(^RCY(34 4.6,"C",TI N)) Q:TIN= ""  D  I Q UIT Q
  17965   "RTN","RCD PEU1",217, 0)
  17966    . S PAYIE N=""
  17967   "RTN","RCD PEU1",218, 0)
  17968    . F  S PA YIEN=$O(^R CY(344.6," C",TIN,PAY IEN)) Q:PA YIEN=""  D   I QUIT Q
  17969   "RTN","RCD PEU1",219, 0)
  17970    . . I '$$ CHKPAY(PAY IEN,$G(PAR AM("TYPE") ,"A"),$G(P ARAM("FILE "))) Q
  17971   "RTN","RCD PEU1",220, 0)
  17972    . . S COU NT=COUNT+1
  17973   "RTN","RCD PEU1",221, 0)
  17974    . . I COU NT>21 S CO UNT=1 I '$ $GOON^VALM 1() S QUIT =1 Q
  17975   "RTN","RCD PEU1",222, 0)
  17976    . . W !,$ E(TIN_$J(" ",30),1,30 )_" "_$E($ $GET1^DIQ( 344.6,PAYI EN_",",.01 ,"E"),1,39 )
  17977   "RTN","RCD PEU1",223, 0)
  17978    Q
  17979   "RTN","RCD PEU1",224, 0)
  17980   INIT ; Ini tialize pa rameters a nd return  array
  17981   "RTN","RCD PEU1",225, 0)
  17982    ; Input -  PARAM arr ay see com ments for  SELPAY abo ve
  17983   "RTN","RCD PEU1",226, 0)
  17984    ;
  17985   "RTN","RCD PEU1",227, 0)
  17986    S PARAM(" TYPE")=$G( PARAM("TYP E"),"A")
  17987   "RTN","RCD PEU1",228, 0)
  17988    S PARAM(" FILE")=$G( PARAM("FIL E"))
  17989   "RTN","RCD PEU1",229, 0)
  17990    S PARAM(" SRCH")=$G( PARAM("SRC H"),"N")
  17991   "RTN","RCD PEU1",230, 0)
  17992    S PARAM(" SELC")=$G( PARAM("SEL C"),"S")
  17993   "RTN","RCD PEU1",231, 0)
  17994    S PARAM(" DICA")=$G( PARAM("DIC A"),"Selec t payer "_ $S(PARAM(" SRCH")="N" :"name",1: "TIN")_":  ")
  17995   "RTN","RCD PEU1",232, 0)
  17996    ;
  17997   "RTN","RCD PEU1",233, 0)
  17998    K ^TMP("R CDPEU1",$J )
  17999   "RTN","RCD PEU1",234, 0)
  18000    Q
  18001   "RTN","RCD PEU1",235, 0)
  18002   CLEAN ; Cl ean up out put array  if user ab orts
  18003   "RTN","RCD PEU1",236, 0)
  18004    K ^TMP("R CDPEU1",$J )
  18005   "RTN","RCD PEU1",237, 0)
  18006    Q
  18007   "RTN","RCD PEU1",238, 0)
  18008   RTYPE(DEF)  ;EP
  18009   "RTN","RCD PEU1",239, 0)
  18010    ; Input:    DEF      - Value to  use a def ault
  18011   "RTN","RCD PEU1",240, 0)
  18012    ; Returns : -1       - User ^ o r timed ou t
  18013   "RTN","RCD PEU1",241, 0)
  18014    ;            A       - User sel ected ALL
  18015   "RTN","RCD PEU1",242, 0)
  18016    ;            M       - User sel ected MEDI CAL
  18017   "RTN","RCD PEU1",243, 0)
  18018    ;            P       - User sel ected PHAR MACY
  18019   "RTN","RCD PEU1",244, 0)
  18020    ;            B       - User sel ected BOTH
  18021   "RTN","RCD PEU1",245, 0)
  18022    N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT,R CTYPE,RETU RN
  18023   "RTN","RCD PEU1",246, 0)
  18024    S RCTYPE= ""
  18025   "RTN","RCD PEU1",247, 0)
  18026    S DIR("?" )="Enter t he type of  payer to  include"
  18027   "RTN","RCD PEU1",248, 0)
  18028    S DIR(0)= "SA^M:MEDI CAL;P:PHAR MACY;T:TRI CARE;A:ALL "
  18029   "RTN","RCD PEU1",249, 0)
  18030    S DIR("A" )="(M)EDIC AL, (P)HAR MACY, (T)R ICARE or ( A)LL: "
  18031   "RTN","RCD PEU1",250, 0)
  18032    S DIR("B" )=$S($G(DE F)'="":DEF ,1:"ALL")
  18033   "RTN","RCD PEU1",251, 0)
  18034    D ^DIR
  18035   "RTN","RCD PEU1",252, 0)
  18036    K DIR
  18037   "RTN","RCD PEU1",253, 0)
  18038    I $D(DTOU T)!$D(DUOU T) Q -1
  18039   "RTN","RCD PEU1",254, 0)
  18040    Q:Y="" "A "
  18041   "RTN","RCD PEU1",255, 0)
  18042    S RETURN= $E(Y)
  18043   "RTN","RCD PEU1",256, 0)
  18044    ; If Phar macy or Tr icare chos en, check  if payer e xist and i f not give  warning
  18045   "RTN","RCD PEU1",257, 0)
  18046    I (RETURN ="P"&('$D( ^RCY(344.6 ,"ARX",1)) )) D WARN( "pharmacy" )
  18047   "RTN","RCD PEU1",258, 0)
  18048    I (RETURN ="T"&('$D( ^RCY(344.6 ,"ATR",1)) )) D WARN( "tricare")
  18049   "RTN","RCD PEU1",259, 0)
  18050    Q RETURN
  18051   "RTN","RCD PEU1",260, 0)
  18052    ;
  18053   "RTN","RCD PEU1",261, 0)
  18054   PAYTYPE(NA ME,TIN,TYP E) ; EP
  18055   "RTN","RCD PEU1",262, 0)
  18056    ; Is a pa yer Medica l, Pharmac y or Trica re based o n flags in  the payer  exclusion  file.
  18057   "RTN","RCD PEU1",263, 0)
  18058    ; Inputs:  NAME - Th e free tex t name of  the payer
  18059   "RTN","RCD PEU1",264, 0)
  18060    ;          TIN  - Th e ID if th e payer
  18061   "RTN","RCD PEU1",265, 0)
  18062    ;          TYPE - M  : Medical,  P : Pharm acy, T: Tr icare
  18063   "RTN","RCD PEU1",266, 0)
  18064    ; Returns  : 1 - Yes , payer ma tches type , 0 - No,  payer does  not match  type
  18065   "RTN","RCD PEU1",267, 0)
  18066    N IEN,FLA G
  18067   "RTN","RCD PEU1",268, 0)
  18068    S IEN=$$G ETPAY(NAME ,TIN)
  18069   "RTN","RCD PEU1",269, 0)
  18070    I 'IEN Q  0
  18071   "RTN","RCD PEU1",270, 0)
  18072    Q $$CHKTY PE(IEN,TYP E)
  18073   "RTN","RCD PEU1",271, 0)
  18074    ;
  18075   "RTN","RCD PEU1",272, 0)
  18076   GETPAY(NAM E,TIN) ; E P - Get pa yer IEN gi ven name a nd TIN
  18077   "RTN","RCD PEU1",273, 0)
  18078    ; Inputs:  NAME - Th e free tex t name of  the payer
  18079   "RTN","RCD PEU1",274, 0)
  18080    ;          TIN  - Th e ID if th e payer
  18081   "RTN","RCD PEU1",275, 0)
  18082    ; Returns : Internal  entry num ber from f ile 344.6
  18083   "RTN","RCD PEU1",276, 0)
  18084    I NAME="" !(TIN)=""  Q 0
  18085   "RTN","RCD PEU1",277, 0)
  18086    Q +$O(^RC Y(344.6,"C PID",NAME, TIN,""))
  18087   "RTN","RCD PEU1",278, 0)
  18088    ;
  18089   "RTN","RCD PEU1",279, 0)
  18090   CHKTYPE(IE N,TYPE) ;  EP
  18091   "RTN","RCD PEU1",280, 0)
  18092    ; Inputs:  IEN - Int ernal entr y number f rom file 3 44.6
  18093   "RTN","RCD PEU1",281, 0)
  18094    ;          TYPE - M  : Medical,  P : Pharm acy, T: Tr icare, A:  All
  18095   "RTN","RCD PEU1",282, 0)
  18096    ; Returns : 1 if the  payer mat ches the t ype, other wise 0
  18097   "RTN","RCD PEU1",283, 0)
  18098    I TYPE="A " Q 1
  18099   "RTN","RCD PEU1",284, 0)
  18100    S FLAG("P ")=+$$GET1 ^DIQ(344.6 ,IEN_",",. 09,"I")
  18101   "RTN","RCD PEU1",285, 0)
  18102    S FLAG("T ")=+$$GET1 ^DIQ(344.6 ,IEN_",",. 1,"I")
  18103   "RTN","RCD PEU1",286, 0)
  18104    ;
  18105   "RTN","RCD PEU1",287, 0)
  18106    I TYPE="T ",FLAG("T" ) Q 1
  18107   "RTN","RCD PEU1",288, 0)
  18108    I TYPE="P ",FLAG("P" ) Q 1
  18109   "RTN","RCD PEU1",289, 0)
  18110    I TYPE="M ",'FLAG("P "),'FLAG(" T") Q 1
  18111   "RTN","RCD PEU1",290, 0)
  18112    Q 0
  18113   "RTN","RCD PEU1",291, 0)
  18114   ISTYPE(FIL E,IEN,TYPE ) ; EP
  18115   "RTN","RCD PEU1",292, 0)
  18116    ; Check i f payer is  a given t ype based  on IEN fro m a FILE
  18117   "RTN","RCD PEU1",293, 0)
  18118    ; Input:  FILE - fil e from whi ch to get  Payer name  and TIN
  18119   "RTN","RCD PEU1",294, 0)
  18120    ;                all owed value s 344.4 -  ERA, 344.3 1 - EFT, 3 61.1 - EOB
  18121   "RTN","RCD PEU1",295, 0)
  18122    ;         IEN  - Int ernal entr y number o f entry in  FILE
  18123   "RTN","RCD PEU1",296, 0)
  18124    ;         TYPE - M :  Medical,  P : Pharma cy, T: Tri care
  18125   "RTN","RCD PEU1",297, 0)
  18126    ; Return  1 - payer  matches ty pe, else 0 .
  18127   "RTN","RCD PEU1",298, 0)
  18128    I TYPE="A " Q 1
  18129   "RTN","RCD PEU1",299, 0)
  18130    N IEN3444 ,NAME,TIN
  18131   "RTN","RCD PEU1",300, 0)
  18132    ; For EOB  try to ge t Payer fr om associa ted ERA, i f none exi sts use TI N only to  check the  type.
  18133   "RTN","RCD PEU1",301, 0)
  18134    I FILE=36 1.1 D  I F ILE=361.1  Q $$EOBTYP (IEN,TYPE)   ;
  18135   "RTN","RCD PEU1",302, 0)
  18136    . S IEN34 44=$$EOBER A(IEN)
  18137   "RTN","RCD PEU1",303, 0)
  18138    . I IEN34 44 S FILE= 344.4,IEN= IEN3444
  18139   "RTN","RCD PEU1",304, 0)
  18140    ;
  18141   "RTN","RCD PEU1",305, 0)
  18142    S NAME=$$ GETNAME(FI LE,IEN)
  18143   "RTN","RCD PEU1",306, 0)
  18144    S TIN=$$G ETTIN(FILE ,IEN)
  18145   "RTN","RCD PEU1",307, 0)
  18146    I NAME="" !(TIN="")  Q 0
  18147   "RTN","RCD PEU1",308, 0)
  18148    Q $$PAYTY PE(NAME,TI N,TYPE)
  18149   "RTN","RCD PEU1",309, 0)
  18150    ;
  18151   "RTN","RCD PEU1",310, 0)
  18152   ISSEL(FILE ,IEN,RCJOB ) ; EP
  18153   "RTN","RCD PEU1",311, 0)
  18154    ; Check i f payer wa s selected  by the us er give th e file and  IEN
  18155   "RTN","RCD PEU1",312, 0)
  18156    ; Input:  FILE - fil e from whi ch to get  Payer name  and TIN
  18157   "RTN","RCD PEU1",313, 0)
  18158    ;                all owed value s 344.4 -  ERA, 344.3 1 - EFT, 3 61.1 - EOB
  18159   "RTN","RCD PEU1",314, 0)
  18160    ;         IEN  - Int ernal entr y number o f entry in  FILE
  18161   "RTN","RCD PEU1",315, 0)
  18162    ; Return  1 - payer  was select ed, else 0 .
  18163   "RTN","RCD PEU1",316, 0)
  18164    ;
  18165   "RTN","RCD PEU1",317, 0)
  18166    N IEN3444 ,NAME,RETU RN,TIN
  18167   "RTN","RCD PEU1",318, 0)
  18168    S RETURN= 0
  18169   "RTN","RCD PEU1",319, 0)
  18170    S RCJOB=$ G(RCJOB,$J )
  18171   "RTN","RCD PEU1",320, 0)
  18172    I FILE=36 1.1 D  I F ILE=361.1  Q RETURN
  18173   "RTN","RCD PEU1",321, 0)
  18174    . S IEN34 44=$$EOBER A(IEN)
  18175   "RTN","RCD PEU1",322, 0)
  18176    . I IEN34 44 D  ;
  18177   "RTN","RCD PEU1",323, 0)
  18178    . . S FIL E=344.4,IE N=IEN3444
  18179   "RTN","RCD PEU1",324, 0)
  18180    . E  D  ;
  18181   "RTN","RCD PEU1",325, 0)
  18182    . . S TIN =$$GET1^DI Q(361.1,IE N_",",.03, "E")
  18183   "RTN","RCD PEU1",326, 0)
  18184    . . I $D( ^TMP("RCDP EU1",RCJOB ,"T",TIN))
  18185   "RTN","RCD PEU1",327, 0)
  18186    ;
  18187   "RTN","RCD PEU1",328, 0)
  18188    S NAME=$$ GETNAME(FI LE,IEN)
  18189   "RTN","RCD PEU1",329, 0)
  18190    S TIN=$$G ETTIN(FILE ,IEN)
  18191   "RTN","RCD PEU1",330, 0)
  18192    I NAME="" !(TIN="")  Q 0
  18193   "RTN","RCD PEU1",331, 0)
  18194    I $D(^TMP ("RCDPEU1" ,RCJOB,"N" ,NAME,TIN) ) S RETURN =1
  18195   "RTN","RCD PEU1",332, 0)
  18196    Q RETURN
  18197   "RTN","RCD PEU1",333, 0)
  18198    ;
  18199   "RTN","RCD PEU1",334, 0)
  18200   GETNAME(FI LE,IEN) ;  Get Payer  Name give  file and I EN
  18201   "RTN","RCD PEU1",335, 0)
  18202    N FIELD
  18203   "RTN","RCD PEU1",336, 0)
  18204    S FIELD=$ S(FILE=344 .4:.06,1:. 02)
  18205   "RTN","RCD PEU1",337, 0)
  18206    Q $$GET1^ DIQ(FILE,I EN_",",FIE LD,"E")
  18207   "RTN","RCD PEU1",338, 0)
  18208    ;
  18209   "RTN","RCD PEU1",339, 0)
  18210   GETTIN(FIL E,IEN) ; G et Payer T IN give fi le and IEN
  18211   "RTN","RCD PEU1",340, 0)
  18212    N FIELD
  18213   "RTN","RCD PEU1",341, 0)
  18214    S FIELD=. 03
  18215   "RTN","RCD PEU1",342, 0)
  18216    Q $$GET1^ DIQ(FILE,I EN_",",FIE LD,"E")
  18217   "RTN","RCD PEU1",343, 0)
  18218    ;
  18219   "RTN","RCD PEU1",344, 0)
  18220   PAYRNG(MIX ED,BLANKLN ,NMORTIN,P ROMPT) ; H ow does th e user wan t to selec t payers?
  18221   "RTN","RCD PEU1",345, 0)
  18222    ; Input:    MIXED    - 1 to dis play promp ts in mixe d case
  18223   "RTN","RCD PEU1",346, 0)
  18224    ;                      Optional , defaults  to 0
  18225   "RTN","RCD PEU1",347, 0)
  18226    ;           BLANKLN  - 0 skip i nitial bla nk line
  18227   "RTN","RCD PEU1",348, 0)
  18228    ;                      Optional , defaults  to 1
  18229   "RTN","RCD PEU1",349, 0)
  18230    ;           NMORTIN  - 1 to loo k-up Payer  by Payer  Name, 2 to  look-up b y TIN
  18231   "RTN","RCD PEU1",350, 0)
  18232    ;                      0 or und efined - p re-326 beh avior, loo k-up by pa yer name a nd don't i nclude TIN  in output  array.
  18233   "RTN","RCD PEU1",351, 0)
  18234    ;                      Optional , defaults  to 0
  18235   "RTN","RCD PEU1",352, 0)
  18236    ;           PROMPT -  Alternati ve prompt
  18237   "RTN","RCD PEU1",353, 0)
  18238    ;
  18239   "RTN","RCD PEU1",354, 0)
  18240    ; Output:   ^TMP("RC SELPAY",$J ) - Array  of selecte d Payers
  18241   "RTN","RCD PEU1",355, 0)
  18242    ; Returns : A - All,  S - Selec ted, R - R ange, (-1)  - User '^ ' or timeo ut
  18243   "RTN","RCD PEU1",356, 0)
  18244    ;
  18245   "RTN","RCD PEU1",357, 0)
  18246    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,RTNFLG,T IN,X,XX,Y
  18247   "RTN","RCD PEU1",358, 0)
  18248    S:'$D(MIX ED) MIXED= 0
  18249   "RTN","RCD PEU1",359, 0)
  18250    S:'$D(BLA NKLN) BLAN KLN=1
  18251   "RTN","RCD PEU1",360, 0)
  18252    S:'$D(NMO RTIN) NMOR TIN=0
  18253   "RTN","RCD PEU1",361, 0)
  18254    I '$D(PRO MPT) S PRO MPT=$S(MIX ED:"Run Re port for", 1:"RUN REP ORT FOR")  ; PRCA*4.5 *332
  18255   "RTN","RCD PEU1",362, 0)
  18256    ;
  18257   "RTN","RCD PEU1",363, 0)
  18258    S RTNFLG= 0
  18259   "RTN","RCD PEU1",364, 0)
  18260    ;
  18261   "RTN","RCD PEU1",365, 0)
  18262    ; Select  option req uired (All , Selected  or Range)
  18263   "RTN","RCD PEU1",366, 0)
  18264    I NMORTIN =2 D
  18265   "RTN","RCD PEU1",367, 0)
  18266    . S DIR(0 )="SA^A:AL L;S:SPECIF IC"
  18267   "RTN","RCD PEU1",368, 0)
  18268    . S:MIXED  DIR("A")= PROMPT_" ( A)LL or (S )PECIFIC I nsurance C ompanies?:  "                ; P RCA*4.5*33 2
  18269   "RTN","RCD PEU1",369, 0)
  18270    . S:'MIXE D DIR("A") =PROMPT_"  (A)LL OR ( S)PECIFIC  INSURANCE  COMPANIES? : "               ; P RCA*4.5*33 2
  18271   "RTN","RCD PEU1",370, 0)
  18272    E  D
  18273   "RTN","RCD PEU1",371, 0)
  18274    . S DIR(0 )="SA^A:AL L;S:SPECIF IC;R:RANGE "
  18275   "RTN","RCD PEU1",372, 0)
  18276    . S:MIXED  DIR("A")= PROMPT_" ( A)LL, (S)P ECIFIC, or  (R)ANGE o f Insuranc e Companie s?: "  ; P RCA*4.5*33 2
  18277   "RTN","RCD PEU1",373, 0)
  18278    . S:'MIXE D DIR("A") =PROMPT_"  (A)LL, (S) PECIFIC, O R (R)ANGE  OF INSURAN CE COMPANI ES?: " ; P RCA*4.5*33 2
  18279   "RTN","RCD PEU1",374, 0)
  18280    . S DIR(" ?",2)="Ent er 'RANGE'  to select  an Insura nce Compan y range."
  18281   "RTN","RCD PEU1",375, 0)
  18282    S DIR("B" )="ALL"
  18283   "RTN","RCD PEU1",376, 0)
  18284    S DIR("?" ,1)="Enter  'ALL' to  select all  Insurance  Companies ."
  18285   "RTN","RCD PEU1",377, 0)
  18286    S DIR("?" )="Enter ' SPECIFIC'  to select  specific I nsurance C ompanies."
  18287   "RTN","RCD PEU1",378, 0)
  18288    W:BLANKLN  !          ; PRCA*4. 5*318 - Ad ded condit ion for BL ANKLN
  18289   "RTN","RCD PEU1",379, 0)
  18290    D ^DIR K  DIR
  18291   "RTN","RCD PEU1",380, 0)
  18292    ;
  18293   "RTN","RCD PEU1",381, 0)
  18294    ; Abort o n ^ exit o r timeout
  18295   "RTN","RCD PEU1",382, 0)
  18296    I $D(DTOU T)!$D(DUOU T) S RTNFL G=-1 Q RTN FLG
  18297   "RTN","RCD PEU1",383, 0)
  18298    ;
  18299   "RTN","RCD PEU1",384, 0)
  18300    Q Y
  18301   "RTN","RCD PEU1",385, 0)
  18302   EOBERA(IEN 3611) ; Ge t ERA that  correspon ds to an E OB so we c an find pa yers.
  18303   "RTN","RCD PEU1",386, 0)
  18304    ; Input I EN3611 - I nternal en try from f ile 361.1  EOB
  18305   "RTN","RCD PEU1",387, 0)
  18306    ; Returns  - Interna l entry nu mber from  file 344.4  ERA
  18307   "RTN","RCD PEU1",388, 0)
  18308    ;            use rev erse $Orde r to get t he latest  ERA in cas e there is  more than  one.
  18309   "RTN","RCD PEU1",389, 0)
  18310    Q $O(^RCY (344.4,"AD ET",+IEN36 11,"A"),-1 )
  18311   "RTN","RCD PEU1",390, 0)
  18312    ;
  18313   "RTN","RCD PEU1",391, 0)
  18314   EOBTYP(IEN 3611,TYPE)  ; If EOB  has no ERA , use TIN  from EOB t o determin e M/P/T ty pe
  18315   "RTN","RCD PEU1",392, 0)
  18316    ; Input I EN3611 - I nternal en try from f ile 361.1  EOB
  18317   "RTN","RCD PEU1",393, 0)
  18318    ;       T YPE - M :  Medical, P  : Pharmac y, T: Tric are
  18319   "RTN","RCD PEU1",394, 0)
  18320    ; Returns  - 1 at le ast one pa yer with T IN is of t ype TYPE
  18321   "RTN","RCD PEU1",395, 0)
  18322    N IEN,TIN
  18323   "RTN","RCD PEU1",396, 0)
  18324    S RETURN= 0
  18325   "RTN","RCD PEU1",397, 0)
  18326    S TIN=$$G ET1^DIQ(36 1.1,IEN361 1_",",.03, "E")
  18327   "RTN","RCD PEU1",398, 0)
  18328    I TIN'=""  D  ;
  18329   "RTN","RCD PEU1",399, 0)
  18330    . S IEN=" "
  18331   "RTN","RCD PEU1",400, 0)
  18332    . F  S IE N=$O(^RCY( 344.6,"C", TIN_" ",IE N)) Q:'IEN   D  Q:RET URN=1
  18333   "RTN","RCD PEU1",401, 0)
  18334    . . S RET URN=$$CHKT YPE(IEN,TY PE)
  18335   "RTN","RCD PEU1",402, 0)
  18336    Q RETURN
  18337   "RTN","RCD PEU1",403, 0)
  18338    ;
  18339   "RTN","RCD PEU1",404, 0)
  18340   RMESS ; Ou tput messa ge that en try is req uired.
  18341   "RTN","RCD PEU1",405, 0)
  18342    W !!,"You  must sele ct "
  18343   "RTN","RCD PEU1",406, 0)
  18344    W $S(PARA M("SELC")= "R":"a",1: "at least  one")_" "
  18345   "RTN","RCD PEU1",407, 0)
  18346    W $S(PARA M("SRCH")= "N":"payer ",1:"TIN") ,*7,!
  18347   "RTN","RCD PEU1",408, 0)
  18348    Q
  18349   "RTN","RCD PEU1",409, 0)
  18350    ;
  18351   "RTN","RCD PEU1",410, 0)
  18352   WARN(TYPE)  ; Warn us er that no  payers of  TYPE have  been flag ged
  18353   "RTN","RCD PEU1",411, 0)
  18354    ; Input:  TYPE - P=P harmacy, T ="Tricare"
  18355   "RTN","RCD PEU1",412, 0)
  18356    ; Output:  warning m essage to  screen.
  18357   "RTN","RCD PEU1",413, 0)
  18358    W !!,"WAR NING - The re are no  "_TYPE_" p ayers flag ged in the  system."
  18359   "RTN","RCD PEU1",414, 0)
  18360    W !,"           Plea se use the  Identify  Payers opt ion to fla g payers." ,*7
  18361   "RTN","RCD PEU1",415, 0)
  18362    Q
  18363   "RTN","RCD PEU2")
  18364   0^35^B4475 9277
  18365   "RTN","RCD PEU2",1,0)
  18366   RCDPEU2 ;A ITC/CJE -  ELECTRONIC  PAYER UTI LITIES ;05 -NOV-02
  18367   "RTN","RCD PEU2",2,0)
  18368    ;;4.5;Acc ounts Rece ivable;**3 26,332**;M ar 20, 199 5;Build 34
  18369   "RTN","RCD PEU2",3,0)
  18370    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  18371   "RTN","RCD PEU2",4,0)
  18372    Q
  18373   "RTN","RCD PEU2",5,0)
  18374   EFT344(PRO MPT,IEN344 ) ; Select  and EFT a nd update  reciept -  EP
  18375   "RTN","RCD PEU2",6,0)
  18376    ; Input:  PROMPT - P rompt to u se when pi cking an E FT
  18377   "RTN","RCD PEU2",7,0)
  18378    ;         IEN344 - I nternal en try number  to file 3 44
  18379   "RTN","RCD PEU2",8,0)
  18380    ; Output
  18381   "RTN","RCD PEU2",9,0)
  18382    N FDA,IEN 34431,SCRE EN
  18383   "RTN","RCD PEU2",10,0 )
  18384    S SCREEN= "I '$O(^RC Y(344,""AE FT"",+Y,0) ),$P($G(^R CY(344.31, +Y,0)),U,8 )=0"
  18385   "RTN","RCD PEU2",11,0 )
  18386    S IEN3443 1=$$ASKEFT (PROMPT,SC REEN)
  18387   "RTN","RCD PEU2",12,0 )
  18388    I IEN3443 1>0,IEN344  D  ;
  18389   "RTN","RCD PEU2",13,0 )
  18390    . S FDA(3 44,IEN344_ ",",.17)=I EN34431
  18391   "RTN","RCD PEU2",14,0 )
  18392    . D FILE^ DIE("","FD A")
  18393   "RTN","RCD PEU2",15,0 )
  18394    . I '$D(^ TMP("DIERR ",$J)) K D IC("W")
  18395   "RTN","RCD PEU2",16,0 )
  18396    . W !!,IE N34431,!!
  18397   "RTN","RCD PEU2",17,0 )
  18398    Q
  18399   "RTN","RCD PEU2",18,0 )
  18400   ASKEFT(PRO MPT,SCREEN ) ; Select  an EFT fo r an EDI L ockbox rec eipt - EP
  18401   "RTN","RCD PEU2",19,0 )
  18402    ; Inputs:  PROMPT -  Prompt to  use when a sking user  to enter  an EFT.
  18403   "RTN","RCD PEU2",20,0 )
  18404    ;          SCREEN -  Screen for  use in fi le 344.31  look-up
  18405   "RTN","RCD PEU2",21,0 )
  18406    ; Returns : IEN from  file 344. 31 or -1 i f user tim es out or  '^'
  18407   "RTN","RCD PEU2",22,0 )
  18408    ;
  18409   "RTN","RCD PEU2",23,0 )
  18410    N COUNT,D A,DIC,DIR, DIRUT,DIRO UT,DTOUT,D UOUT,FIELD S,FILE,FLA GS,IENS,IN DEXES,QUIT ,RETURN,VA LUE,X,Y
  18411   "RTN","RCD PEU2",24,0 )
  18412    K ^TMP("D ILIST",$J) ,^TMP("DIE RR",$J)
  18413   "RTN","RCD PEU2",25,0 )
  18414    S (RETURN ,QUIT)=0
  18415   "RTN","RCD PEU2",26,0 )
  18416    S FILE=34 4.31,IENS= ""
  18417   "RTN","RCD PEU2",27,0 )
  18418    S FIELDS= ".01;.02;. 03;.04;.07 ;.14"
  18419   "RTN","RCD PEU2",28,0 )
  18420    S FLAGS=" M"
  18421   "RTN","RCD PEU2",29,0 )
  18422    S INDEXES =""
  18423   "RTN","RCD PEU2",30,0 )
  18424    F  D  Q:Q UIT  ;
  18425   "RTN","RCD PEU2",31,0 )
  18426    . W !,PRO MPT R VALU E:DT
  18427   "RTN","RCD PEU2",32,0 )
  18428    . I '$T S  QUIT=1,RE TURN=-1 Q   ; Timeout
  18429   "RTN","RCD PEU2",33,0 )
  18430    . I VALUE ="" S QUIT =1,RETURN= 0 Q
  18431   "RTN","RCD PEU2",34,0 )
  18432    . I $E(VA LUE)="^"!( VALUE="")  S QUIT=1,R ETURN=-1 Q
  18433   "RTN","RCD PEU2",35,0 )
  18434    . I $E(VA LUE)="?" S  VALUE=""
  18435   "RTN","RCD PEU2",36,0 )
  18436    . I VALUE ="" D  ;
  18437   "RTN","RCD PEU2",37,0 )
  18438    . . D LIS T^DIC(FILE ,"",FIELDS ,FLAGS,"*" ,"","","B" ,SCREEN,"" ,"","")
  18439   "RTN","RCD PEU2",38,0 )
  18440    . E  D  ;
  18441   "RTN","RCD PEU2",39,0 )
  18442    . . D FIN D^DIC(FILE ,"",FIELDS ,FLAGS,VAL UE,"","",S CREEN,""," ","")
  18443   "RTN","RCD PEU2",40,0 )
  18444    . S COUNT =$P($G(^TM P("DILIST" ,$J,0)),"^ ",1)
  18445   "RTN","RCD PEU2",41,0 )
  18446    . I COUNT =1,VALUE'= "" D  Q  ;
  18447   "RTN","RCD PEU2",42,0 )
  18448    . . S RET URN=+$P($G (^TMP("DIL IST",$J,2, 1)),"^",1) ,QUIT=1
  18449   "RTN","RCD PEU2",43,0 )
  18450    . I COUNT >0 D  ;
  18451   "RTN","RCD PEU2",44,0 )
  18452    . . S RET URN=$$PICK EFT()
  18453   "RTN","RCD PEU2",45,0 )
  18454    . . I RET URN>0 S QU IT=1
  18455   "RTN","RCD PEU2",46,0 )
  18456    Q RETURN
  18457   "RTN","RCD PEU2",47,0 )
  18458    ;
  18459   "RTN","RCD PEU2",48,0 )
  18460   PICKEFT()  ; Given ou tput from  FIND^DIC,  pick an EF T from the  list
  18461   "RTN","RCD PEU2",49,0 )
  18462    ; Input:  ^TMP("DILI ST",$J) in  non-packe d format
  18463   "RTN","RCD PEU2",50,0 )
  18464    ; Returns : IEN from  file 344. 31, or 0 i f user doe s not pick  an item f rom the li st
  18465   "RTN","RCD PEU2",51,0 )
  18466    ;
  18467   "RTN","RCD PEU2",52,0 )
  18468    N CNT,COU NT,QUIT,RE TURN
  18469   "RTN","RCD PEU2",53,0 )
  18470    S COUNT=$ P($G(^TMP( "DILIST",$ J,0)),"^", 1)
  18471   "RTN","RCD PEU2",54,0 )
  18472    S (RETURN ,QUIT)=0
  18473   "RTN","RCD PEU2",55,0 )
  18474    F CNT=1:1 :COUNT D   Q:QUIT  ;
  18475   "RTN","RCD PEU2",56,0 )
  18476    . D WRITE (CNT)
  18477   "RTN","RCD PEU2",57,0 )
  18478    . I CNT#1 0=0!(CNT=C OUNT) D  Q :QUIT  ;
  18479   "RTN","RCD PEU2",58,0 )
  18480    . . S RET URN=$$READ (CNT) I RE TURN=-1!(R ETURN>0) S  QUIT=1
  18481   "RTN","RCD PEU2",59,0 )
  18482    Q RETURN
  18483   "RTN","RCD PEU2",60,0 )
  18484    ;
  18485   "RTN","RCD PEU2",61,0 )
  18486   READ(LAST)  ;
  18487   "RTN","RCD PEU2",62,0 )
  18488    ; Input:  LAST - The  last numb er display ed that ca n be picke d in the n umber rang e 1-LAST
  18489   "RTN","RCD PEU2",63,0 )
  18490    ; Returns : IEN from  344.31 if  one is pi cked, othe rwise -1 ( ^ or timeo ut) or 0 -  nothing p icked
  18491   "RTN","RCD PEU2",64,0 )
  18492    N DA,DIR, DIROUT,DIR UT,DTOUT,D UOUT,QUIT, RETURN,VAL UE,X,Y
  18493   "RTN","RCD PEU2",65,0 )
  18494    S RETURN= 0
  18495   "RTN","RCD PEU2",66,0 )
  18496    S DIR(0)= "NO^1:"_LA ST
  18497   "RTN","RCD PEU2",67,0 )
  18498    D ^DIR
  18499   "RTN","RCD PEU2",68,0 )
  18500    I $D(DTOU T)!($D(DUO UT)) Q -1
  18501   "RTN","RCD PEU2",69,0 )
  18502    I Y,$D(^T MP("DILIST ",$J,2,Y))  S RETURN= ^TMP("DILI ST",$J,2,Y )
  18503   "RTN","RCD PEU2",70,0 )
  18504    Q RETURN
  18505   "RTN","RCD PEU2",71,0 )
  18506   WRITE(X) ;  Write out  one entry  from 344. 31
  18507   "RTN","RCD PEU2",72,0 )
  18508    ; Input:  X=Counter  from ^TMP( "DILIST",$ J) output  from FIND^ DIC
  18509   "RTN","RCD PEU2",73,0 )
  18510    ; Output:  To screen
  18511   "RTN","RCD PEU2",74,0 )
  18512    N DEPDAT, DEPNO,EFTI D,EFTIEN,E FTTR,PAYAM T,PAYNAM,P AYTR,SP,TI N
  18513   "RTN","RCD PEU2",75,0 )
  18514    S SP=$J(" ",3)
  18515   "RTN","RCD PEU2",76,0 )
  18516    S EFTIEN= $P(^TMP("D ILIST",$J, 1,X),".")
  18517   "RTN","RCD PEU2",77,0 )
  18518    S EFTID=^ TMP("DILIS T",$J,"ID" ,X,.01)
  18519   "RTN","RCD PEU2",78,0 )
  18520    S PAYNAM= ^TMP("DILI ST",$J,"ID ",X,.02)
  18521   "RTN","RCD PEU2",79,0 )
  18522    S TIN=^TM P("DILIST" ,$J,"ID",X ,.03)
  18523   "RTN","RCD PEU2",80,0 )
  18524    S PAYTR=^ TMP("DILIS T",$J,"ID" ,X,.04)
  18525   "RTN","RCD PEU2",81,0 )
  18526    S PAYAMT= ^TMP("DILI ST",$J,"ID ",X,.07)
  18527   "RTN","RCD PEU2",82,0 )
  18528    S DEPNO=$ $GET1^DIQ( 344.3,EFTI EN,.03,"E" )
  18529   "RTN","RCD PEU2",83,0 )
  18530    S DEPDAT= $$FMTE^XLF DT($$GET1^ DIQ(344.3, EFTIEN,.07 ,"I"),"2DZ ")
  18531   "RTN","RCD PEU2",84,0 )
  18532    ; EFT DET AIL lookup
  18533   "RTN","RCD PEU2",85,0 )
  18534    S PAYNAM= $E(PAYNAM, 1,62-$L(TI N))_"/"_TI N I PAYNAM ="/" S PAY NAM=""
  18535   "RTN","RCD PEU2",86,0 )
  18536    W !,$J(X, 4),?7,EFTI D,?16," ", PAYNAM
  18537   "RTN","RCD PEU2",87,0 )
  18538    W !,?16,"  ",PAYTR,? 48," ",$J( PAYAMT,10)
  18539   "RTN","RCD PEU2",88,0 )
  18540    W ?59," " ,DEPNO,?71 ," ",DEPDA T
  18541   "RTN","RCD PEU2",89,0 )
  18542    Q
  18543   "RTN","RCD PEU2",90,0 )
  18544    ;
  18545   "RTN","RCD PEU2",91,0 )
  18546    ; PRCA*4. 5*332 - St art modifi ed code bl ock
  18547   "RTN","RCD PEU2",92,0 )
  18548   CHKEOB(RCR ECTDA,RCTR ANDA,RCARR AY) ; EP f rom RCDPLP L3/4- Link  payment t o account,  move/copy  remove EO Bs
  18549   "RTN","RCD PEU2",93,0 )
  18550    ; Inputs  RCRECTDA -  Receipt I EN file 34 4
  18551   "RTN","RCD PEU2",94,0 )
  18552    ;         RCTRANDA   - Payment  multiple 3 44.01 IEN  under RCRE CTDA
  18553   "RTN","RCD PEU2",95,0 )
  18554    ;         RCARRAY  -  If linkin g to multi ple claims  this arra y contains  the list  of claims
  18555   "RTN","RCD PEU2",96,0 )
  18556    ;                     A1^A2^A3^ A4 where A 1=Account  Linked to,  A2=Amount , A3=Comme nt, A4=Acc ount Name
  18557   "RTN","RCD PEU2",97,0 )
  18558    ; Outputs  None
  18559   "RTN","RCD PEU2",98,0 )
  18560    N CCLAIM, CLAIM,IEN3 44491,IEN3 611,IFN,JU ST,JUST1,L CLAIM,NCLA IM,NCLAIMS ,OIFN,ORIG ,QUIT
  18561   "RTN","RCD PEU2",99,0 )
  18562    N RCERA,R CORIG,RCOS EQ,RCSEQ,R CLORIG,RCS ORIG,SCLAI M,X
  18563   "RTN","RCD PEU2",100, 0)
  18564    ;
  18565   "RTN","RCD PEU2",101, 0)
  18566    S RCERA=$ $GET1^DIQ( 344,RCRECT DA_",",.18 ,"I")
  18567   "RTN","RCD PEU2",102, 0)
  18568    S RCSEQ=$ $GET1^DIQ( 344.01,RCT RANDA_","_ RCRECTDA_" ,",.27,"I" )
  18569   "RTN","RCD PEU2",103, 0)
  18570    S RCOSEQ= $$GET1^DIQ (344.491,R CSEQ_","_R CERA_",",. 01,"E")\1
  18571   "RTN","RCD PEU2",104, 0)
  18572    I 'RCOSEQ  Q  ; No s cratch pad  entry for  this paym ent, can n ot proceed .
  18573   "RTN","RCD PEU2",105, 0)
  18574    S IEN3611 =$$ORIG(RC ERA,RCOSEQ )
  18575   "RTN","RCD PEU2",106, 0)
  18576    I 'IEN361 1 Q  ; Can  not ident ify origin al EOB, ca n not proc eed
  18577   "RTN","RCD PEU2",107, 0)
  18578    S ORIG=$$ GET1^DIQ(3 61.1,IEN36 11_",",.01 ,"E") ; Or iginal Cla im#
  18579   "RTN","RCD PEU2",108, 0)
  18580    S OIFN=$$ GET1^DIQ(3 61.1,IEN36 11_",",.01 ,"I") ; Or iginal Bil l IEN 399
  18581   "RTN","RCD PEU2",109, 0)
  18582    ;
  18583   "RTN","RCD PEU2",110, 0)
  18584    S (RCSORI G,RCLORIG, RCLSUSP)=0
  18585   "RTN","RCD PEU2",111, 0)
  18586    ; Check t he scratch  pad.  Get  claims us ed in init ial split/ edit.
  18587   "RTN","RCD PEU2",112, 0)
  18588    ; Store c laims othe r than ori ginal in S CLAIM arra y.
  18589   "RTN","RCD PEU2",113, 0)
  18590    ; If part  payment w as left on  original  claim set  RCSORIG=1
  18591   "RTN","RCD PEU2",114, 0)
  18592    S X=RCOSE Q
  18593   "RTN","RCD PEU2",115, 0)
  18594    F  S X=$O (^RCY(344. 49,RCERA,1 ,"B",X)) Q :((X\1)'=R COSEQ)  D   ;
  18595   "RTN","RCD PEU2",116, 0)
  18596    . S IEN34 4491=""
  18597   "RTN","RCD PEU2",117, 0)
  18598    . F  S IE N344491=$O (^RCY(344. 49,RCERA,1 ,"B",X,IEN 344491)) Q :'IEN34449 1  D  ;
  18599   "RTN","RCD PEU2",118, 0)
  18600    . . I +$$ GET1^DIQ(3 44.491,IEN 344491_"," _RCERA_"," ,.03)=0 Q   ; Ignore  lines with  zero valu e
  18601   "RTN","RCD PEU2",119, 0)
  18602    . . S CLA IM=$$GET1^ DIQ(344.49 1,IEN34449 1_","_RCER A_",",.02, "E")
  18603   "RTN","RCD PEU2",120, 0)
  18604    . . I CLA IM=ORIG D   ;
  18605   "RTN","RCD PEU2",121, 0)
  18606    . . . S R CSORIG=1
  18607   "RTN","RCD PEU2",122, 0)
  18608    . . E  D   ;
  18609   "RTN","RCD PEU2",123, 0)
  18610    . . . S I FN=$$GET1^ DIQ(344.49 1,IEN34449 1_","_RCER A_",",.07, "I")
  18611   "RTN","RCD PEU2",124, 0)
  18612    . . . I I FN S SCLAI M(IFN)=IFN
  18613   "RTN","RCD PEU2",125, 0)
  18614    ;
  18615   "RTN","RCD PEU2",126, 0)
  18616    ; Check l ink paymen t details.   Get clai ms we are  linking to  now.
  18617   "RTN","RCD PEU2",127, 0)
  18618    ; Store c laims othe r than ori ginal in L CLAIM arra y.
  18619   "RTN","RCD PEU2",128, 0)
  18620    ; If part  payment w as left on  original  claim set  RCLORIG=1
  18621   "RTN","RCD PEU2",129, 0)
  18622    S (NCLAIM ,NCLAIMS)= ""
  18623   "RTN","RCD PEU2",130, 0)
  18624    I '$D(RCA RRAY) D
  18625   "RTN","RCD PEU2",131, 0)
  18626    . S NCLAI M=$$GET1^D IQ(344.01, RCTRANDA_" ,"_RCRECTD A_",",.03, "E")
  18627   "RTN","RCD PEU2",132, 0)
  18628    . I NCLAI M["-" S NC LAIM=$P(NC LAIM,"-",2 )
  18629   "RTN","RCD PEU2",133, 0)
  18630    . I NCLAI M=ORIG S R CLORIG=1 Q
  18631   "RTN","RCD PEU2",134, 0)
  18632    . ; Money  is going  on a new c laim.
  18633   "RTN","RCD PEU2",135, 0)
  18634    . S IFN=$ O(^DGCR(39 9,"B",NCLA IM,""))
  18635   "RTN","RCD PEU2",136, 0)
  18636    . I IFN S  LCLAIM(IF N)=IFN
  18637   "RTN","RCD PEU2",137, 0)
  18638    E  D
  18639   "RTN","RCD PEU2",138, 0)
  18640    . S X=0
  18641   "RTN","RCD PEU2",139, 0)
  18642    . F  S X= $O(RCARRAY (X)) Q:'X   D
  18643   "RTN","RCD PEU2",140, 0)
  18644    . . ; Che ck if some  money is  going back  to the or iginal cla im or rema ins in sus pense.
  18645   "RTN","RCD PEU2",141, 0)
  18646    . . I $P( RCARRAY(X) ,"^",2)'=0  D  ;
  18647   "RTN","RCD PEU2",142, 0)
  18648    . . . I $ P(RCARRAY( X),"^",1)= "" S RCLSU SP=1  Q  ;  Some mone y going ba ck to susp ense
  18649   "RTN","RCD PEU2",143, 0)
  18650    . . . S C LAIM=$P(RC ARRAY(X)," ^",4)
  18651   "RTN","RCD PEU2",144, 0)
  18652    . . . I C LAIM=ORIG  S RCLORIG= 1 Q  ; Mon ey going b ack to ori ginal clai m
  18653   "RTN","RCD PEU2",145, 0)
  18654    . . . I N CLAIMS'=""  S NCLAIMS =NCLAIMS_" ,"
  18655   "RTN","RCD PEU2",146, 0)
  18656    . . . S N CLAIMS=NCL AIMS_CLAIM
  18657   "RTN","RCD PEU2",147, 0)
  18658    . . . S I FN=$O(^DGC R(399,"B", CLAIM,""))
  18659   "RTN","RCD PEU2",148, 0)
  18660    . . . I I FN S LCLAI M(IFN)=IFN
  18661   "RTN","RCD PEU2",149, 0)
  18662    ;
  18663   "RTN","RCD PEU2",150, 0)
  18664    ; Do we n eed to mov e the EOB  or copy it  to new cl aims
  18665   "RTN","RCD PEU2",151, 0)
  18666    ; We will  move the  EOB, if th e whole pa yment was  put in sus pense then  linked to  a single  new claim
  18667   "RTN","RCD PEU2",152, 0)
  18668    I '$D(SCL AIM),'$D(R CARRAY),'R CLORIG,'RC SORIG D  Q   ;
  18669   "RTN","RCD PEU2",153, 0)
  18670    . K CLAIM
  18671   "RTN","RCD PEU2",154, 0)
  18672    . S IFN=$ O(^DGCR(39 9,"B",NCLA IM,""))
  18673   "RTN","RCD PEU2",155, 0)
  18674    . I IFN D   ;
  18675   "RTN","RCD PEU2",156, 0)
  18676    . . S CLA IM(1)=IFN
  18677   "RTN","RCD PEU2",157, 0)
  18678    . . ; Cha nge claim  number on  original E OB attache d to ERA
  18679   "RTN","RCD PEU2",158, 0)
  18680    . . D AUT OMOVE^RCDP EM5(IEN361 1,.CLAIM," L")
  18681   "RTN","RCD PEU2",159, 0)
  18682    ;
  18683   "RTN","RCD PEU2",160, 0)
  18684    ; We will  copy the  EOB if mon ey put int o suspense  is linked  to multip le claims.
  18685   "RTN","RCD PEU2",161, 0)
  18686    ; *Or* if  some mone y went to  other clai ms in the  original s plit.
  18687   "RTN","RCD PEU2",162, 0)
  18688    I $D(SCLA IM)!(RCSOR IG)!($D(RC ARRAY)) D   ;
  18689   "RTN","RCD PEU2",163, 0)
  18690    . K CLAIM
  18691   "RTN","RCD PEU2",164, 0)
  18692    . I '$D(R CARRAY),'R CLORIG D   ;
  18693   "RTN","RCD PEU2",165, 0)
  18694    . . S IFN =$O(^DGCR( 399,"B",NC LAIM,""))
  18695   "RTN","RCD PEU2",166, 0)
  18696    . . I '$D (SCLAIM(IF N)) S CLAI M(IFN)=IFN  ; Link to  single cl aim not in  the origi nal split
  18697   "RTN","RCD PEU2",167, 0)
  18698    . I $D(RC ARRAY) D   ;
  18699   "RTN","RCD PEU2",168, 0)
  18700    . . S X=" " F  S X=$ O(LCLAIM(X )) Q:'X  D   ;
  18701   "RTN","RCD PEU2",169, 0)
  18702    . . . I ' $D(SCLAIM( X)) S CLAI M(X)=X ; L ink to a c laim that  was not in cluded in  original s plit
  18703   "RTN","RCD PEU2",170, 0)
  18704    . I $D(CL AIM) D  ;  Copy EOB t o CLAIM(s)
  18705   "RTN","RCD PEU2",171, 0)
  18706    . . ; Cop y EOB to n ew EOBs fo r "to" cla ims
  18707   "RTN","RCD PEU2",172, 0)
  18708    . . D AUT OCOPY^RCDP EM5(IEN361 1,.CLAIM," L")
  18709   "RTN","RCD PEU2",173, 0)
  18710    ;
  18711   "RTN","RCD PEU2",174, 0)
  18712    ; Remove  the origin al EOB if  no money l eft in sus pense, or  split or l inked to o riginal cl aim
  18713   "RTN","RCD PEU2",175, 0)
  18714    I 'RCSORI G,'RCLORIG ,'RCLSUSP  D  ;
  18715   "RTN","RCD PEU2",176, 0)
  18716    . S JUST= "EEOB remo ved when p ayment fro m suspense  was linke d to claim (s) "_NCLA IMS
  18717   "RTN","RCD PEU2",177, 0)
  18718    . D AUTOR EM^RCDPEM5 (IEN3611,J UST)
  18719   "RTN","RCD PEU2",178, 0)
  18720    ;
  18721   "RTN","RCD PEU2",179, 0)
  18722    Q
  18723   "RTN","RCD PEU2",180, 0)
  18724    ;
  18725   "RTN","RCD PEU2",181, 0)
  18726   ORIG(RCERA ,RCOSEQ) ;  Get the o riginal cl aim from t he EOB wor klist
  18727   "RTN","RCD PEU2",182, 0)
  18728    ; Inputs  RCERA - ER A IEN from  file 344. 49
  18729   "RTN","RCD PEU2",183, 0)
  18730    ;         RCOSEQ - S equence nu mber IEN f rom multip le 344.491
  18731   "RTN","RCD PEU2",184, 0)
  18732    ; Returns  IEN from  361.1. EOB  from 344. 41
  18733   "RTN","RCD PEU2",185, 0)
  18734    N EEOBS,I EN491
  18735   "RTN","RCD PEU2",186, 0)
  18736    S IEN491= $O(^RCY(34 4.49,RCERA ,1,"ASEQ", RCOSEQ,0))
  18737   "RTN","RCD PEU2",187, 0)
  18738    I IEN491= "" Q "" ;  Can't find  reference d sequence  number.
  18739   "RTN","RCD PEU2",188, 0)
  18740    S EEOBS=$ $GET1^DIQ( 344.491,IE N491_","_R CERA_",",. 09,"E")
  18741   "RTN","RCD PEU2",189, 0)
  18742    I EEOBS[" ADJ"!(EEOB S[",") Q " "  ; Don't  proceed i f this is  not a spli t line.
  18743   "RTN","RCD PEU2",190, 0)
  18744    Q $$GET1^ DIQ(344.41 ,(+EEOBS)_ ","_RCERA_ ",",.02,"I ")
  18745   "RTN","RCD PEU2",191, 0)
  18746    ; PRCA*4. 5*332 - En d modified  code bloc k
  18747   "RTN","RCD PEUPO")
  18748   0^22^B4734 9551
  18749   "RTN","RCD PEUPO",1,0 )
  18750   RCDPEUPO ; ALBANY/KML  - Unposte d EFT Over ride ;3 Oc t 2018 10: 46:35
  18751   "RTN","RCD PEUPO",2,0 )
  18752    ;;4.5;Acc ounts Rece ivable;**2 98,332**;M ar 20, 199 5;Build 34
  18753   "RTN","RCD PEUPO",3,0 )
  18754    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  18755   "RTN","RCD PEUPO",4,0 )
  18756    Q
  18757   "RTN","RCD PEUPO",5,0 )
  18758    ;
  18759   "RTN","RCD PEUPO",6,0 )
  18760    ; prca*4. 5*298 - pr ocedures b uilt to im plement th e Unposted  EFT Overr ide option
  18761   "RTN","RCD PEUPO",7,0 )
  18762    ;
  18763   "RTN","RCD PEUPO",8,0 )
  18764   EN ;  Disp lay warnin g message  when aged,  unposted  EFTs exist
  18765   "RTN","RCD PEUPO",9,0 )
  18766    N MSG
  18767   "RTN","RCD PEUPO",10, 0)
  18768    D OWNSKEY ^XUSRB(.MS G,"RCDPE A GED PMT",D UZ)
  18769   "RTN","RCD PEUPO",11, 0)
  18770    I 'MSG(0)  D NOENTRY  Q
  18771   "RTN","RCD PEUPO",12, 0)
  18772    N AGEDEFT S
  18773   "RTN","RCD PEUPO",13, 0)
  18774    S AGEDEFT S=$$GETEFT S^RCDPEWLP ("A",1)  ;  need to e xamine bot h medical  and pharma cy EFTs
  18775   "RTN","RCD PEUPO",14, 0)
  18776    D DMSGS(A GEDEFTS)
  18777   "RTN","RCD PEUPO",15, 0)
  18778    Q
  18779   "RTN","RCD PEUPO",16, 0)
  18780    ;
  18781   "RTN","RCD PEUPO",17, 0)
  18782   DMSGS(CODE S) ; displ ay warning /error mes sages (if  any)
  18783   "RTN","RCD PEUPO",18, 0)
  18784    ; Input:    CODES   
  18785   "RTN","RCD PEUPO",19, 0)
  18786    ; 1P - er ror condit ion for ag ed, unpost ed Pharmac y EFTs
  18787   "RTN","RCD PEUPO",20, 0)
  18788    ; 2P - wa rning cond ition for  aged,unpos ted Pharma cy EFTs
  18789   "RTN","RCD PEUPO",21, 0)
  18790    ; 3P - Ov erride exi sts for ag ed, unpost ed pharmac y EFTs
  18791   "RTN","RCD PEUPO",22, 0)
  18792    ; 1M - er ror condit ion for ag ed, unpost ed Medical  EFTs
  18793   "RTN","RCD PEUPO",23, 0)
  18794    ; 2M - wa rning cond ition for  aged, unpo sted Medic al EFTs
  18795   "RTN","RCD PEUPO",24, 0)
  18796    ; 3M - Ov erride exi sts for ag ed, unpost ed Medical  EFTs
  18797   "RTN","RCD PEUPO",25, 0)
  18798    ; 1T - er ror condit ion for ag ed, unpost ed Tricare  EFTs
  18799   "RTN","RCD PEUPO",26, 0)
  18800    ; 2T - wa rning cond ition for  aged, unpo sted Trica re EFTs
  18801   "RTN","RCD PEUPO",27, 0)
  18802    ; 3T - Ov erride exi sts for ag ed, unpost ed Tricare  EFTs
  18803   "RTN","RCD PEUPO",28, 0)
  18804    ;  0 - no  error or  warning co nditions
  18805   "RTN","RCD PEUPO",29, 0)
  18806    ;  possib le values:
  18807   "RTN","RCD PEUPO",30, 0)
  18808    ; "1P" or  "2P" or " 3P" or "1M " or "2M"  or "3M" or  "1P^1M" o r "1P^2M"  or
  18809   "RTN","RCD PEUPO",31, 0)
  18810    ; "1P^3M"  or "2P^1M " or "2P^2 M" or "2P^ 3M" or "3P ^1M" or "3 P^2M" or " 3P^3M"
  18811   "RTN","RCD PEUPO",32, 0)
  18812    I 'CODES  D NONE Q
  18813   "RTN","RCD PEUPO",33, 0)
  18814    N DAYSLIM T,DIR,ERRO R,I,LN,MSG TXT,OVERRI DE,S1,S2,S TATE,TYPE, X,Y
  18815   "RTN","RCD PEUPO",34, 0)
  18816    S (OVERRI DE,ERROR)= 0
  18817   "RTN","RCD PEUPO",35, 0)
  18818    S DIR("A" ,1)="Curre nt Warning  and/or Er ror messag es for Unp osted EFTs :"
  18819   "RTN","RCD PEUPO",36, 0)
  18820    S DIR("A" ,2)=" ",LN =2
  18821   "RTN","RCD PEUPO",37, 0)
  18822    F I=1:1 S  STATE=$P( CODES,U,I)  Q:STATE=" "  D
  18823   "RTN","RCD PEUPO",38, 0)
  18824    . S S1=$E (STATE,1), S2=$E(STAT E,2)
  18825   "RTN","RCD PEUPO",39, 0)
  18826    . I S1=1  D  ; 1 = E RROR
  18827   "RTN","RCD PEUPO",40, 0)
  18828    ..  S ERR OR=1,TYPE= $G(TYPE)_S 2
  18829   "RTN","RCD PEUPO",41, 0)
  18830    ..  ; Num ber of day s an EFT c an age bef ore post p revention  rules appl y
  18831   "RTN","RCD PEUPO",42, 0)
  18832    ..  S DAY SLIMT=$$GE T1^DIQ(344 .61,1,$S(S 2="M":.06, S2="P":.07 ,1:.13))
  18833   "RTN","RCD PEUPO",43, 0)
  18834    ..  S LN= LN+1
  18835   "RTN","RCD PEUPO",44, 0)
  18836    ..  S DIR ("A",LN)=" ERROR: Unp osted "_$S (S2="P":"p harmacy ", S2="M":"me dical ",1: "TRICARE " )
  18837   "RTN","RCD PEUPO",45, 0)
  18838    ..  S DIR ("A",LN)=D IR("A",LN) _"EFTs exi st that ar e more tha n "_DAYSLI MT_" days  old."
  18839   "RTN","RCD PEUPO",46, 0)
  18840    ..  S LN= LN+1,DIR(" A",LN)="Sc ratchpad c reation is  not allow ed for new er payment s."
  18841   "RTN","RCD PEUPO",47, 0)
  18842    ..  S LN= LN+1,DIR(" A",LN)=" "
  18843   "RTN","RCD PEUPO",48, 0)
  18844    . I S1=2  D  ; 2 = w arning
  18845   "RTN","RCD PEUPO",49, 0)
  18846    ..  S LN= LN+1
  18847   "RTN","RCD PEUPO",50, 0)
  18848    ..  S DIR ("A",LN)=" WARNING: U nposted "_ $S(S2="P": "pharmacy  ",S2="M":" medical ", 1:"TRICARE  ")
  18849   "RTN","RCD PEUPO",51, 0)
  18850    ..  S DIR ("A",LN)=D IR("A",LN) _"EFTs exi st that ar e more tha n "
  18851   "RTN","RCD PEUPO",52, 0)
  18852    ..  S DIR ("A",LN)=D IR("A",LN) _$S(S2="P" :21,1:14)_ " days old ."
  18853   "RTN","RCD PEUPO",53, 0)
  18854    ..  S LN= LN+1,DIR(" A",LN)=" "
  18855   "RTN","RCD PEUPO",54, 0)
  18856    . I S1=3  D  ; OVERR IDE
  18857   "RTN","RCD PEUPO",55, 0)
  18858    ..  S OVE RRIDE=OVER RIDE+1
  18859   "RTN","RCD PEUPO",56, 0)
  18860    ..  S LN= LN+1,DIR(" A",LN)="An  Override  for "_$S(S 2="P":"pha rmacy ",S2 ="M":"medi cal ",1:"T RICARE ")
  18861   "RTN","RCD PEUPO",57, 0)
  18862    ..  S DIR ("A",LN)=D IR("A",LN) _"is alrea dy in plac e."
  18863   "RTN","RCD PEUPO",58, 0)
  18864    ..  S LN= LN+1,DIR(" A",LN)=" "
  18865   "RTN","RCD PEUPO",59, 0)
  18866    I OVERRID E=3 D  Q
  18867   "RTN","RCD PEUPO",60, 0)
  18868    . S DIR(0 )="EA",DIR ("A")="Pre ss ENTER t o continue : "
  18869   "RTN","RCD PEUPO",61, 0)
  18870    . D ^DIR
  18871   "RTN","RCD PEUPO",62, 0)
  18872    I ERROR D
  18873   "RTN","RCD PEUPO",63, 0)
  18874    . M MSGTX T=DIR("A")
  18875   "RTN","RCD PEUPO",64, 0)
  18876    . S DIR(0 )="YA"
  18877   "RTN","RCD PEUPO",65, 0)
  18878    . S LN=LN +1,DIR("A" ,LN)="An o verride wi ll allow u nrestricte d scratchp ad creatio n for one  day."
  18879   "RTN","RCD PEUPO",66, 0)
  18880    . S DIR(" A")="Do yo u want to  continue ( Y/N)? "
  18881   "RTN","RCD PEUPO",67, 0)
  18882    . D ^DIR
  18883   "RTN","RCD PEUPO",68, 0)
  18884    . Q:'Y
  18885   "RTN","RCD PEUPO",69, 0)
  18886    . S OVERR IDE=$$OVER RIDE(TYPE, .MSGTXT)
  18887   "RTN","RCD PEUPO",70, 0)
  18888    . I OVERR IDE D MAIL (.MSGTXT)
  18889   "RTN","RCD PEUPO",71, 0)
  18890    I 'ERROR  D
  18891   "RTN","RCD PEUPO",72, 0)
  18892    . S LN=LN +1,DIR("A" ,LN)="Ther e are no e rror condi tions to o verride."
  18893   "RTN","RCD PEUPO",73, 0)
  18894    . S LN=LN +1,DIR("A" ,LN)=" ",D IR("A")="P ress ENTER  to contin ue: "
  18895   "RTN","RCD PEUPO",74, 0)
  18896    . S DIR(0 )="EA" D ^ DIR
  18897   "RTN","RCD PEUPO",75, 0)
  18898    Q
  18899   "RTN","RCD PEUPO",76, 0)
  18900    ;
  18901   "RTN","RCD PEUPO",77, 0)
  18902   OVERRIDE(T YPE,TEXT)  ; when ERR OR state e xists, per form the O verride
  18903   "RTN","RCD PEUPO",78, 0)
  18904    ; Input:    TYPE     - "M" Medi cal
  18905   "RTN","RCD PEUPO",79, 0)
  18906    ;                      "P" Pham acy
  18907   "RTN","RCD PEUPO",80, 0)
  18908    ;                      "T" - Tr icare
  18909   "RTN","RCD PEUPO",81, 0)
  18910    ;                      Any comb ination of  above fla gs
  18911   "RTN","RCD PEUPO",82, 0)
  18912    ;           TEXT     - Warning  and/or err or stateme nts; passe d by refer ence
  18913   "RTN","RCD PEUPO",83, 0)
  18914    ; Output:   TEXT     - Addition al text to  be displa yed with w arning and /or error  statements
  18915   "RTN","RCD PEUPO",84, 0)
  18916    ;                      contents  of TEXT a rray will  be in the  body of th e mail mes sage
  18917   "RTN","RCD PEUPO",85, 0)
  18918    ;                      (refer t o MAIL tag )
  18919   "RTN","RCD PEUPO",86, 0)
  18920    ; Returns : DONE     - 1 - OVER RIDE was p erformed;   0 - Overr ide was no t performe d
  18921   "RTN","RCD PEUPO",87, 0)
  18922    ;
  18923   "RTN","RCD PEUPO",88, 0)
  18924    N DIR,DIR UT,DONE,DT TM,DUOUT,R CDFDA,REAS ON,X1,Y
  18925   "RTN","RCD PEUPO",89, 0)
  18926    L +^RCY(3 44.61,1,0) :DILOCKTM  E  D NOLOC K S DONE=0  G OVERQ
  18927   "RTN","RCD PEUPO",90, 0)
  18928    S DONE=1
  18929   "RTN","RCD PEUPO",91, 0)
  18930    I TYPE="P "!(TYPE="M ")!(TYPE=" T") D
  18931   "RTN","RCD PEUPO",92, 0)
  18932    . S DIR(0 )="EA",DIR ("A",1)="A n Override  now exist s for post ing "
  18933   "RTN","RCD PEUPO",93, 0)
  18934    . S DIR(" A",1)=DIR( "A",1)_$S( TYPE="P":" pharmacy " ,TYPE="M": "medical " ,1:"TRICAR E ")_"paym ents."
  18935   "RTN","RCD PEUPO",94, 0)
  18936    . S DIR(" A",2)=" "
  18937   "RTN","RCD PEUPO",95, 0)
  18938    . S DIR(" A")="Press  ENTER to  continue:  "
  18939   "RTN","RCD PEUPO",96, 0)
  18940    . D ^DIR
  18941   "RTN","RCD PEUPO",97, 0)
  18942    I $L(TYPE )>1 D  I ' DONE G OVE RQ
  18943   "RTN","RCD PEUPO",98, 0)
  18944    . S DIR(0 )="SA^"
  18945   "RTN","RCD PEUPO",99, 0)
  18946    . S:TYPE[ "M" DIR(0) =DIR(0)_"M :Medical;"
  18947   "RTN","RCD PEUPO",100 ,0)
  18948    . S:TYPE[ "P" DIR(0) =DIR(0)_"P :Pharmacy; "
  18949   "RTN","RCD PEUPO",101 ,0)
  18950    . S:TYPE[ "T" DIR(0) =DIR(0)_"T :TRICARE;"
  18951   "RTN","RCD PEUPO",102 ,0)
  18952    . I $L(TY PE)=3 S DI R("A")="Ov erride for  (M)edical , (P)harma cy or (T)R ICARE? "
  18953   "RTN","RCD PEUPO",103 ,0)
  18954    . E  D
  18955   "RTN","RCD PEUPO",104 ,0)
  18956    . . S DIR ("A")="Ove rride for  "
  18957   "RTN","RCD PEUPO",105 ,0)
  18958    . . I (TY PE="PM")!( TYPE="MP")  S DIR("A" )=DIR("A") _"(M)edica l or (P)ha rmacy? "
  18959   "RTN","RCD PEUPO",106 ,0)
  18960    . . E  I  (TYPE="PT" )!(TYPE="T P") S DIR( "A")=DIR(" A")_"(P)ha rmacy or ( T)RICARE?  "
  18961   "RTN","RCD PEUPO",107 ,0)
  18962    . . E  S  DIR("A")=D IR("A")_"( M)edical o r (T)RICAR E? "
  18963   "RTN","RCD PEUPO",108 ,0)
  18964    . D ^DIR
  18965   "RTN","RCD PEUPO",109 ,0)
  18966    . I $D(DU OUT)!($D(D IRUT)) S D ONE=0 Q
  18967   "RTN","RCD PEUPO",110 ,0)
  18968    . S TYPE= Y
  18969   "RTN","RCD PEUPO",111 ,0)
  18970    W !
  18971   "RTN","RCD PEUPO",112 ,0)
  18972    K DIR
  18973   "RTN","RCD PEUPO",113 ,0)
  18974    S DIR("A" )="Reason  for Overri de: ",DIR( 0)="FA^1:5 0"
  18975   "RTN","RCD PEUPO",114 ,0)
  18976    D ^DIR
  18977   "RTN","RCD PEUPO",115 ,0)
  18978    I $D(DUOU T)!($D(DIR UT)) D  G  OVERQ
  18979   "RTN","RCD PEUPO",116 ,0)
  18980    . S DONE= 0
  18981   "RTN","RCD PEUPO",117 ,0)
  18982    . W !!,"    Need to  enter a re ason for O verride.", !,"   Over ride not p erformed." ,!
  18983   "RTN","RCD PEUPO",118 ,0)
  18984    S REASON= Y,DTTM=$$N OW^XLFDT
  18985   "RTN","RCD PEUPO",119 ,0)
  18986    S RCDFDA( 344.61,"1, ",$S(TYPE= "M":20,TYP E="P":21,1 :26))=DTTM
  18987   "RTN","RCD PEUPO",120 ,0)
  18988    S RCDFDA( 344.61,"1, ",$S(TYPE= "M":22,TYP E="P":23,1 :27))=DUZ
  18989   "RTN","RCD PEUPO",121 ,0)
  18990    S RCDFDA( 344.61,"1, ",$S(TYPE= "M":24,TYP E="P":25,1 :28))=REAS ON
  18991   "RTN","RCD PEUPO",122 ,0)
  18992    D FILE^DI E("","RCDF DA")
  18993   "RTN","RCD PEUPO",123 ,0)
  18994    S X1="" S  X1=$O(TEX T(X1),-1)
  18995   "RTN","RCD PEUPO",124 ,0)
  18996    S X1=X1+1
  18997   "RTN","RCD PEUPO",125 ,0)
  18998    S TEXT(X1 )=$S(TYPE= "M":"Medic al ",TYPE= "P":"Pharm acy ",1:"T RICARE ")_ "Override  Details"
  18999   "RTN","RCD PEUPO",126 ,0)
  19000    S X1=X1+1
  19001   "RTN","RCD PEUPO",127 ,0)
  19002    S TEXT(X1 )="User: " _$P($G(^VA (200,DUZ,0 )),"^") S  X1=X1+1
  19003   "RTN","RCD PEUPO",128 ,0)
  19004    S TEXT(X1 )="Date/Ti me: "_DTTM
  19005   "RTN","RCD PEUPO",129 ,0)
  19006    S TEXT(X1 )="Reason  for Overri de: "_REAS ON
  19007   "RTN","RCD PEUPO",130 ,0)
  19008   OVERQ ;
  19009   "RTN","RCD PEUPO",131 ,0)
  19010    L -^RCY(3 44.61,1,0)
  19011   "RTN","RCD PEUPO",132 ,0)
  19012    Q DONE
  19013   "RTN","RCD PEUPO",133 ,0)
  19014    ;
  19015   "RTN","RCD PEUPO",134 ,0)
  19016   MAIL(TEXT)  ;generate  mail mess age when O VERRIDE is  implement ed
  19017   "RTN","RCD PEUPO",135 ,0)
  19018    ; Input:    TEXT     - Lines of  text that  represent  the body  of the mai l message
  19019   "RTN","RCD PEUPO",136 ,0)
  19020    ;
  19021   "RTN","RCD PEUPO",137 ,0)
  19022    N ARRAY,C NT,CNT1,GL B,RCPROG1, SBJ,SUB
  19023   "RTN","RCD PEUPO",138 ,0)
  19024    S RCPROG1 ="RCDUPEO" ,GLB=$NA(^ TMP(RCPROG 1,$J,"XMTE XT"))
  19025   "RTN","RCD PEUPO",139 ,0)
  19026    ;
  19027   "RTN","RCD PEUPO",140 ,0)
  19028    ;Build he ader
  19029   "RTN","RCD PEUPO",141 ,0)
  19030    S SUB="EF T" K @GLB
  19031   "RTN","RCD PEUPO",142 ,0)
  19032    S SBJ="ED I LBOX-STA # "_$P($$S ITE^VASITE ,"^",3)_"- Unposted E FTs Overri de "_$$FMT E^XLFDT($$ NOW^XLFDT)
  19033   "RTN","RCD PEUPO",143 ,0)
  19034    M @GLB=TE XT
  19035   "RTN","RCD PEUPO",144 ,0)
  19036    N XMDUZ,X MINSTR,XMS UB,XMTEXT, XMY
  19037   "RTN","RCD PEUPO",145 ,0)
  19038    S XMDUZ=D UZ,XMTEXT= GLB,XMSUB= SBJ,XMY("I :G.RCDPE A UDIT")=""
  19039   "RTN","RCD PEUPO",146 ,0)
  19040    S XMINSTR ("FROM")=" POSTMASTER "
  19041   "RTN","RCD PEUPO",147 ,0)
  19042    S XMINSTR ("FLAGS")= "P"
  19043   "RTN","RCD PEUPO",148 ,0)
  19044    D SENDMSG ^XMXAPI(XM DUZ,XMSUB, XMTEXT,.XM Y,.XMINSTR )
  19045   "RTN","RCD PEUPO",149 ,0)
  19046    Q
  19047   "RTN","RCD PEUPO",150 ,0)
  19048    ;
  19049   "RTN","RCD PEUPO",151 ,0)
  19050   CHECK(TYPE ,OVERRIDE)  ; Determi ne if over ride exist s for toda y's date
  19051   "RTN","RCD PEUPO",152 ,0)
  19052    ; Input:    TYPE         - "M"  for medica l, "P" for  Pharmacy  or "T" for  Tricare
  19053   "RTN","RCD PEUPO",153 ,0)
  19054    ;           OVERRIDE     - Pass ed by refe rence; arr ay to hold  the OVERR IDE data
  19055   "RTN","RCD PEUPO",154 ,0)
  19056    ; Output:   OVERRIDE     - Retu rned array  holding e xisting OV ERRIDE dat a
  19057   "RTN","RCD PEUPO",155 ,0)
  19058    K OVERRID E
  19059   "RTN","RCD PEUPO",156 ,0)
  19060    ;
  19061   "RTN","RCD PEUPO",157 ,0)
  19062    ; Get MED ICAL EFT O VERRIDE (3 44.61, 20) , PHARMACY  EFT OVERR IDE (344.6 1, 21) or
  19063   "RTN","RCD PEUPO",158 ,0)
  19064    ; TRICARE  EFT OVERR IDE (344.6 1, 20) dat e dependen t on type  of EFTs
  19065   "RTN","RCD PEUPO",159 ,0)
  19066    S OVERRID E(TYPE)=+$ $GET1^DIQ( 344.61,1,$ S(TYPE="M" :20,TYPE=" P":21,1:26 ),"I")
  19067   "RTN","RCD PEUPO",160 ,0)
  19068    I 'OVERRI DE(TYPE) K  OVERRIDE( TYPE) S OV ERRIDE=0 Q
  19069   "RTN","RCD PEUPO",161 ,0)
  19070    ;
  19071   "RTN","RCD PEUPO",162 ,0)
  19072    ; Overrid e does not  exist for  'TODAYS'  date,  pos t preventi on rules w ill apply
  19073   "RTN","RCD PEUPO",163 ,0)
  19074    I $P(OVER RIDE(TYPE) ,".")'=DT  K OVERRIDE (TYPE)  S  OVERRIDE=0  Q
  19075   "RTN","RCD PEUPO",164 ,0)
  19076    S OVERRID E=1
  19077   "RTN","RCD PEUPO",165 ,0)
  19078    Q
  19079   "RTN","RCD PEUPO",166 ,0)
  19080    ;
  19081   "RTN","RCD PEUPO",167 ,0)
  19082   NONE ; the  system do es not hav e any aged , unposted  EFTs
  19083   "RTN","RCD PEUPO",168 ,0)
  19084    N DIR
  19085   "RTN","RCD PEUPO",169 ,0)
  19086    S DIR(0)= "EA"
  19087   "RTN","RCD PEUPO",170 ,0)
  19088    S DIR("A" ,1)="The s ytem does  not have a ny aged, u nposted EF Ts."
  19089   "RTN","RCD PEUPO",171 ,0)
  19090    S DIR("A" ,2)="There fore, no e rror condi tions to o verride."
  19091   "RTN","RCD PEUPO",172 ,0)
  19092    S DIR("A" ,3)=" "
  19093   "RTN","RCD PEUPO",173 ,0)
  19094    S DIR("A" )="Press E NTER to co ntinue: "
  19095   "RTN","RCD PEUPO",174 ,0)
  19096    D ^DIR
  19097   "RTN","RCD PEUPO",175 ,0)
  19098    Q
  19099   "RTN","RCD PEUPO",176 ,0)
  19100    ;
  19101   "RTN","RCD PEUPO",177 ,0)
  19102   NOACTION ;  OVERRIDE  already ex ists
  19103   "RTN","RCD PEUPO",178 ,0)
  19104    ; Input:    TYPE     - "M" for  medical, " P" for Pha rmacy or " T" for Tri care
  19105   "RTN","RCD PEUPO",179 ,0)
  19106    N DIR
  19107   "RTN","RCD PEUPO",180 ,0)
  19108    S DIR(0)= "EA"
  19109   "RTN","RCD PEUPO",181 ,0)
  19110    S DIR("A" ,1)="An Ov erride for  "_$S(TYPE ="P":"phar macy ",TYP E="M":"med ical ",1:" TRICARE ")
  19111   "RTN","RCD PEUPO",182 ,0)
  19112    S DIR("A" ,1)=DIR("A ",1)_"is a lready in  place."
  19113   "RTN","RCD PEUPO",183 ,0)
  19114    S DIR("A" ,2)="No ac tion neede d"
  19115   "RTN","RCD PEUPO",184 ,0)
  19116    S DIR("A" ,3)=" "
  19117   "RTN","RCD PEUPO",185 ,0)
  19118    S DIR("A" )="Press E NTER to co ntinue: "
  19119   "RTN","RCD PEUPO",186 ,0)
  19120    D ^DIR
  19121   "RTN","RCD PEUPO",187 ,0)
  19122    Q
  19123   "RTN","RCD PEUPO",188 ,0)
  19124    ;
  19125   "RTN","RCD PEUPO",189 ,0)
  19126   NOENTRY ;   user is n ot authori zed to use  the optio n
  19127   "RTN","RCD PEUPO",190 ,0)
  19128    N DIR
  19129   "RTN","RCD PEUPO",191 ,0)
  19130    S DIR(0)= "EA"
  19131   "RTN","RCD PEUPO",192 ,0)
  19132    S DIR("A" ,1)="You a re not aut horized to  use this  option."
  19133   "RTN","RCD PEUPO",193 ,0)
  19134    S DIR("A" ,2)="This  option is  locked wit h RCDPE AG ED PMT key ."
  19135   "RTN","RCD PEUPO",194 ,0)
  19136    S DIR("A" ,3)=" "
  19137   "RTN","RCD PEUPO",195 ,0)
  19138    S DIR("A" )="Press E NTER to co ntinue: "
  19139   "RTN","RCD PEUPO",196 ,0)
  19140    D ^DIR
  19141   "RTN","RCD PEUPO",197 ,0)
  19142    Q
  19143   "RTN","RCD PEUPO",198 ,0)
  19144    ;
  19145   "RTN","RCD PEUPO",199 ,0)
  19146   NOLOCK ; e ntry at 34 4.61 canno t be locke d
  19147   "RTN","RCD PEUPO",200 ,0)
  19148    N DIR
  19149   "RTN","RCD PEUPO",201 ,0)
  19150    S DIR(0)= "EA"
  19151   "RTN","RCD PEUPO",202 ,0)
  19152    S DIR("A" ,1)="Anoth er user is  editing t he Overrid e Paramete rs."
  19153   "RTN","RCD PEUPO",203 ,0)
  19154    S DIR("A" ,2)="Try a gain later ."
  19155   "RTN","RCD PEUPO",204 ,0)
  19156    S DIR("A" ,3)=" "
  19157   "RTN","RCD PEUPO",205 ,0)
  19158    S DIR("A" )="Press E NTER to co ntinue: "
  19159   "RTN","RCD PEUPO",206 ,0)
  19160    D ^DIR
  19161   "RTN","RCD PEUPO",207 ,0)
  19162    Q
  19163   "RTN","RCD PEUPO",208 ,0)
  19164    ;
  19165   "RTN","RCD PEWL0")
  19166   0^42^B2223 44847
  19167   "RTN","RCD PEWL0",1,0 )
  19168   RCDPEWL0 ; ALB/TMK/PJ H - ELECTR ONIC EOB W ORKLIST AC TIONS ;Jun  06, 2014@ 19:11:19
  19169   "RTN","RCD PEWL0",2,0 )
  19170    ;;4.5;Acc ounts Rece ivable;**1 73,208,252 ,269,298,3 17,321,326 ,332**;Mar  20, 1995; Build 34
  19171   "RTN","RCD PEWL0",3,0 )
  19172    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  19173   "RTN","RCD PEWL0",4,0 )
  19174    Q
  19175   "RTN","RCD PEWL0",5,0 )
  19176    ;
  19177   "RTN","RCD PEWL0",6,0 )
  19178   PARAMS(SOU RCE) ; Ret rieve/Edit /Save View  Parameter s for ERA  Worklist
  19179   "RTN","RCD PEWL0",7,0 )
  19180    ; Input:    SOURCE       - "MO"  - Menu Op tion
  19181   "RTN","RCD PEWL0",8,0 )
  19182    ;                          "CV"  - Change  View Actio n
  19183   "RTN","RCD PEWL0",9,0 )
  19184    ; Output:  Sort/Filt ering Crit eria for t he worklis t sent int o ^TMP("RC ERA_PARAMS ",$J)
  19185   "RTN","RCD PEWL0",10, 0)
  19186    ;          ^TMP("RCE RA_PARAMS" ,$J,"RCPOS T") - ERA  Posting St atus ("P": Posted/"U" :Unposted)
  19187   "RTN","RCD PEWL0",11, 0)
  19188    ;          ^TMP("RCE RA_PARAMS" ,$J,"RCAUT OP")- Auto -Posting Q ueue
  19189   "RTN","RCD PEWL0",12, 0)
  19190    ;                                                ("A" :Auto-Post ing/"N":No n Auto-Pos ting/"B":B oth)
  19191   "RTN","RCD PEWL0",13, 0)
  19192    ;          ^TMP("RCE RA_PARAMS" ,$J,"RCAPS TA")- Auto -Posting S tatus  ; P RCA*4.5*32 6
  19193   "RTN","RCD PEWL0",14, 0)
  19194    ;                                                ("M" :Marked/"P ":Partial/ "C":Comple te/"A":All )
  19195   "RTN","RCD PEWL0",15, 0)
  19196    ;          ^TMP("RCE RA_PARAMS" ,$J,"RCMAT CH")- ERA  Matching S tatus ("M" :Matched/" U":Unmatch ed)
  19197   "RTN","RCD PEWL0",16, 0)
  19198    ;          ^TMP("RCE RA_PARAMS" ,$J,"RCTYP E") - ERA  Claim Type  ("M":Medi cal/"P":Ph armacy/"B" :Both)
  19199   "RTN","RCD PEWL0",17, 0)
  19200    ;          ^TMP("RCE RA_PARAMS" ,$J,"RCDT" )   - A1^A 2 Where:
  19201   "RTN","RCD PEWL0",18, 0)
  19202    ;                                                A1 -  ERA Recei ved EARLIE ST DATE (R ange Limit ed Only)
  19203   "RTN","RCD PEWL0",19, 0)
  19204    ;                                                A2 -  ERA Recei ved LATEST  DATE (Ran ge Limited  Only)
  19205   "RTN","RCD PEWL0",20, 0)
  19206    ;          ^TMP("RCE RA_PARAMS" ,$J,"RCPAY R") - B1^B 2^B3 Where :
  19207   "RTN","RCD PEWL0",21, 0)
  19208    ;                                                B1 -  All Payer s/Range of  Payers
  19209   "RTN","RCD PEWL0",22, 0)
  19210    ;                                                      ("A": All /"R":Range  of Payers )
  19211   "RTN","RCD PEWL0",23, 0)
  19212    ;                                                B2 -  START WIT H PAYER (e .g.,'AET')
  19213   "RTN","RCD PEWL0",24, 0)
  19214    ;                                                      (Range Li mited Only )
  19215   "RTN","RCD PEWL0",25, 0)
  19216    ;                                                B3 -  GO TO PAY ER (e.g.,' AETZ') (Ra nge Limite d Only)
  19217   "RTN","RCD PEWL0",26, 0)
  19218    ;
  19219   "RTN","RCD PEWL0",27, 0)
  19220    ;          ^TMP("RCE RA_PVW",$J ) - Same l ayout as ^ TMP("RCERA _PARAMS",$ J).  This  global con tains
  19221   "RTN","RCD PEWL0",28, 0)
  19222    ;                                   the so rt/filters  of the us er's prefe rred view  (for ERA m ain page)
  19223   "RTN","RCD PEWL0",29, 0)
  19224    ;                                   while  ^TMP("RCER A_PARAMS", $J) contai ns the sor t/filters  of what is
  19225   "RTN","RCD PEWL0",30, 0)
  19226    ;                                   curren tly displa yed.  They  may or ma y not be t he same va lues.
  19227   "RTN","RCD PEWL0",31, 0)
  19228    ;
  19229   "RTN","RCD PEWL0",32, 0)
  19230    ;           ^TMP("RC SCRATCH_PV W",$J)   -  This glob al contain s the sort /filters o f the user 's preferr ed view
  19231   "RTN","RCD PEWL0",33, 0)
  19232    ;                                   for th e Scratch  Pad.  See  PARAMS^RCD PEWLA for  the layout .
  19233   "RTN","RCD PEWL0",34, 0)
  19234    ;
  19235   "RTN","RCD PEWL0",35, 0)
  19236    ;          RCQUIT=1  if the use r exited o ut, 0 othe rwise
  19237   "RTN","RCD PEWL0",36, 0)
  19238    ;
  19239   "RTN","RCD PEWL0",37, 0)
  19240    N RCXPAR, USEPVW,X,X X,Y                 ;  PRCA*4.5* 317 Added  USEPVW,XX
  19241   "RTN","RCD PEWL0",38, 0)
  19242    S RCQUIT= 0
  19243   "RTN","RCD PEWL0",39, 0)
  19244    ;
  19245   "RTN","RCD PEWL0",40, 0)
  19246    ; Ask Dat e Range Se lection wh en coming  straight f rom the me nu option
  19247   "RTN","RCD PEWL0",41, 0)
  19248    I SOURCE= "MO" D  Q: RCQUIT
  19249   "RTN","RCD PEWL0",42, 0)
  19250    . K ^TMP( "RCERA_PAR AMS",$J),^ TMP("RCERA _PVW",$J), ^TMP("RCSC RATCH_PVW" ,$J)
  19251   "RTN","RCD PEWL0",43, 0)
  19252    . S RCQUI T=$$DTR()   ; Set dat e range fi lter
  19253   "RTN","RCD PEWL0",44, 0)
  19254    . Q:RCQUI T
  19255   "RTN","RCD PEWL0",45, 0)
  19256    . ;
  19257   "RTN","RCD PEWL0",46, 0)
  19258    . ;Retrie ve user's  saved pref erred view  (if any)
  19259   "RTN","RCD PEWL0",47, 0)
  19260    . D GETWL PVW(.RCXPA R)
  19261   "RTN","RCD PEWL0",48, 0)
  19262    ;
  19263   "RTN","RCD PEWL0",49, 0)
  19264    ;Only ask  user if t hey want t o use thei r preferre d view in  the follow ing scenar ios:
  19265   "RTN","RCD PEWL0",50, 0)
  19266    ; a) Sour ce is "MO"  and user  has a pref erred view  on file
  19267   "RTN","RCD PEWL0",51, 0)
  19268    ; b) Sour ce is "CV"  (change v iew action ), user ha s a prefer red view b ut is
  19269   "RTN","RCD PEWL0",52, 0)
  19270    ;    not  using the  preferred  view crite ria at thi s time.
  19271   "RTN","RCD PEWL0",53, 0)
  19272    S XX=$$PR EFVW(SOURC E)
  19273   "RTN","RCD PEWL0",54, 0)
  19274    I ((XX=1) &(SOURCE=" MO"))!((XX =0)&(SOURC E="CV")) D   Q:USEPVW
  19275   "RTN","RCD PEWL0",55, 0)
  19276    . ;
  19277   "RTN","RCD PEWL0",56, 0)
  19278    . ; Ask t he user if  they want  to use th e preferre d view
  19279   "RTN","RCD PEWL0",57, 0)
  19280    . S USEPV W=$$ASKUVW ()
  19281   "RTN","RCD PEWL0",58, 0)
  19282    . I USEPV W=-1 S RCQ UIT=1 Q
  19283   "RTN","RCD PEWL0",59, 0)
  19284    . Q:'USEP VW
  19285   "RTN","RCD PEWL0",60, 0)
  19286    . ;
  19287   "RTN","RCD PEWL0",61, 0)
  19288    . ; Set t he Sort/Fi ltering Cr iteria fro m the pref erred view  
  19289   "RTN","RCD PEWL0",62, 0)
  19290    . M ^TMP( "RCERA_PAR AMS",$J)=^ TMP("RCERA _PVW",$J)
  19291   "RTN","RCD PEWL0",63, 0)
  19292    ;
  19293   "RTN","RCD PEWL0",64, 0)
  19294    W !!,"Sel ect parame ters for d isplaying  the list o f ERAs"
  19295   "RTN","RCD PEWL0",65, 0)
  19296    S RCQUIT= $$PARAMS2^ RCDPEWLD()
  19297   "RTN","RCD PEWL0",66, 0)
  19298    Q:RCQUIT
  19299   "RTN","RCD PEWL0",67, 0)
  19300    D SAVEPVW                                      ; Ask  if they wa nt to save  as prefer red view
  19301   "RTN","RCD PEWL0",68, 0)
  19302    Q
  19303   "RTN","RCD PEWL0",69, 0)
  19304    ;
  19305   "RTN","RCD PEWL0",70, 0)
  19306   GETWLPVW(R CXPAR) ;   Retrieves  the prefer red view s ettings fo r the ERA  worklist
  19307   "RTN","RCD PEWL0",71, 0)
  19308    ; for the  user
  19309   "RTN","RCD PEWL0",72, 0)
  19310    ; Input:    None
  19311   "RTN","RCD PEWL0",73, 0)
  19312    ; Output:   RCXPAR()                 - Arr ay of pref erred view  sort/filt er criteri a
  19313   "RTN","RCD PEWL0",74, 0)
  19314    ;           ^TMP("RC ERA_PARAMS ",$J)- Glo bal array  of preferr ed view se ttings
  19315   "RTN","RCD PEWL0",75, 0)
  19316    ;           ^TMP("RC ERA_PVW")       - A c opy of the  preferred  settings  (if any)
  19317   "RTN","RCD PEWL0",76, 0)
  19318    N XX
  19319   "RTN","RCD PEWL0",77, 0)
  19320    K RCXPAR
  19321   "RTN","RCD PEWL0",78, 0)
  19322    D GETLST^ XPAR(.RCXP AR,"USR"," RCDPE EDI  LOCKBOX WO RKLIST","I ")
  19323   "RTN","RCD PEWL0",79, 0)
  19324    D:$D(RCXP AR("ERA_PO STING_STAT US")) PVWS AVE(.RCXPA R)
  19325   "RTN","RCD PEWL0",80, 0)
  19326    ;
  19327   "RTN","RCD PEWL0",81, 0)
  19328    S XX=$G(R CXPAR("ERA _POSTING_S TATUS"))
  19329   "RTN","RCD PEWL0",82, 0)
  19330    S ^TMP("R CERA_PARAM S",$J,"RCP OST")=$S(X X'="":XX,1 :"U")
  19331   "RTN","RCD PEWL0",83, 0)
  19332    S XX=$G(R CXPAR("ERA _AUTO_POST ING"))
  19333   "RTN","RCD PEWL0",84, 0)
  19334    S ^TMP("R CERA_PARAM S",$J,"RCA UTOP")=$S( XX'="":XX, 1:"B")
  19335   "RTN","RCD PEWL0",85, 0)
  19336    S XX=$G(R CXPAR("ERA -EFT_MATCH _STATUS"))
  19337   "RTN","RCD PEWL0",86, 0)
  19338    S ^TMP("R CERA_PARAM S",$J,"RCM ATCH")=$S( XX'="":XX, 1:"B")
  19339   "RTN","RCD PEWL0",87, 0)
  19340    S XX=$G(R CXPAR("ERA _CLAIM_TYP E"))
  19341   "RTN","RCD PEWL0",88, 0)
  19342    ; S ^TMP( "RCERA_PAR AMS",$J,"R CTYPE")=$S (XX'="":XX ,1:"B")      ; PRCA*4 .5*321
  19343   "RTN","RCD PEWL0",89, 0)
  19344    S ^TMP("R CERA_PARAM S",$J,"RCT YPE")=$S(X X'="":XX,1 :"A")        ; PRCA*4 .5*321 cha nge defaul t to (A)LL
  19345   "RTN","RCD PEWL0",90, 0)
  19346    S XX=$G(R CXPAR("ALL _PAYERS/RA NGE_OF_PAY ERS"))
  19347   "RTN","RCD PEWL0",91, 0)
  19348    S ^TMP("R CERA_PARAM S",$J,"RCP AYR")=$S(X X'="":$TR( XX,";","^" ),1:"A")
  19349   "RTN","RCD PEWL0",92, 0)
  19350    S XX=$G(R CXPAR("ERA _PAYMENT_T YPE"))                                    ;  PRCA*4.5* 321 new fi lter
  19351   "RTN","RCD PEWL0",93, 0)
  19352    S ^TMP("R CERA_PARAM S",$J,"RCP AYMNT")=$S (XX'="":XX ,1:"B")             ;  PRCA*4.5* 321
  19353   "RTN","RCD PEWL0",94, 0)
  19354    S XX=$G(R CXPAR("AUT O-POST_STA TUS")) ; P RCA*4.5*32 6
  19355   "RTN","RCD PEWL0",95, 0)
  19356    S ^TMP("R CERA_PARAM S",$J,"RCA PSTA")=$S( XX'="":XX, 1:"A") ; P RCA*4.5*32 6
  19357   "RTN","RCD PEWL0",96, 0)
  19358    Q
  19359   "RTN","RCD PEWL0",97, 0)
  19360    ;
  19361   "RTN","RCD PEWL0",98, 0)
  19362   PVWSAVE(RC XPAR) ; Sa ve a copy  of the pre ferred vie w on file
  19363   "RTN","RCD PEWL0",99, 0)
  19364    ; PRCA*4. 5*317 adde d subrouti ne
  19365   "RTN","RCD PEWL0",100 ,0)
  19366    ; Input:    RCXPAR              - array of  preferred  view sett ing for th e user
  19367   "RTN","RCD PEWL0",101 ,0)
  19368    ; Output:   ^TMP("RC ERA_PVW")  - a copy o f the pref erred sett ings
  19369   "RTN","RCD PEWL0",102 ,0)
  19370    ;
  19371   "RTN","RCD PEWL0",103 ,0)
  19372    K ^TMP("R CERA_PVW", $J)
  19373   "RTN","RCD PEWL0",104 ,0)
  19374    ; only co ntinue if  we have an swers to a ll ERA Wor klist rela ted prefer red view p rompts
  19375   "RTN","RCD PEWL0",105 ,0)
  19376    Q:'$D(RCX PAR("ERA_P OSTING_STA TUS"))
  19377   "RTN","RCD PEWL0",106 ,0)
  19378    Q:'$D(RCX PAR("ERA_A UTO_POSTIN G"))
  19379   "RTN","RCD PEWL0",107 ,0)
  19380    Q:'$D(RCX PAR("ERA-E FT_MATCH_S TATUS"))
  19381   "RTN","RCD PEWL0",108 ,0)
  19382    Q:'$D(RCX PAR("ERA_C LAIM_TYPE" ))
  19383   "RTN","RCD PEWL0",109 ,0)
  19384    Q:'$D(RCX PAR("ALL_P AYERS/RANG E_OF_PAYER S"))
  19385   "RTN","RCD PEWL0",110 ,0)
  19386    Q:'$D(RCX PAR("ERA_P AYMENT_TYP E"))  ; PR CA*4.5*321
  19387   "RTN","RCD PEWL0",111 ,0)
  19388    Q:'$D(RCX PAR("AUTO- POST_STATU S"))  ; PR CA*4.5*326
  19389   "RTN","RCD PEWL0",112 ,0)
  19390    ;
  19391   "RTN","RCD PEWL0",113 ,0)
  19392    S ^TMP("R CERA_PVW", $J,"RCPOST ")=RCXPAR( "ERA_POSTI NG_STATUS" )
  19393   "RTN","RCD PEWL0",114 ,0)
  19394    S ^TMP("R CERA_PVW", $J,"RCAUTO P")=RCXPAR ("ERA_AUTO _POSTING")
  19395   "RTN","RCD PEWL0",115 ,0)
  19396    S ^TMP("R CERA_PVW", $J,"RCMATC H")=RCXPAR ("ERA-EFT_ MATCH_STAT US")
  19397   "RTN","RCD PEWL0",116 ,0)
  19398    S ^TMP("R CERA_PVW", $J,"RCTYPE ")=RCXPAR( "ERA_CLAIM _TYPE")
  19399   "RTN","RCD PEWL0",117 ,0)
  19400    S ^TMP("R CERA_PVW", $J,"RCPAYR ")=$TR(RCX PAR("ALL_P AYERS/RANG E_OF_PAYER S"),";","^ ")
  19401   "RTN","RCD PEWL0",118 ,0)
  19402    S ^TMP("R CERA_PVW", $J,"RCPAYM NT")=RCXPA R("ERA_PAY MENT_TYPE" ) ; PRCA*4 .5*321 new  filter
  19403   "RTN","RCD PEWL0",119 ,0)
  19404    S ^TMP("R CERA_PVW", $J,"RCPAPS T")=RCXPAR ("AUTO-POS T_STATUS")  ; PRCA*4. 5*326
  19405   "RTN","RCD PEWL0",120 ,0)
  19406    Q
  19407   "RTN","RCD PEWL0",121 ,0)
  19408    ;
  19409   "RTN","RCD PEWL0",122 ,0)
  19410   PREFVW(SOU RCE) ; Che cks to see  if the us er has a p referred v iew
  19411   "RTN","RCD PEWL0",123 ,0)
  19412    ; PRCA*4. 5*317 adde d subrouti ne
  19413   "RTN","RCD PEWL0",124 ,0)
  19414    ; When so urce is 'C V', checks  to see if  the prefe rred view  is being u sed
  19415   "RTN","RCD PEWL0",125 ,0)
  19416    ; Input:    SOURCE                    - 'M O' - When  called fro m the Work list menu
  19417   "RTN","RCD PEWL0",126 ,0)
  19418    ;                                               optio n
  19419   "RTN","RCD PEWL0",127 ,0)
  19420    ;                                       'C V' - When  called fro m the Chan ge View
  19421   "RTN","RCD PEWL0",128 ,0)
  19422    ;                                               actio n
  19423   "RTN","RCD PEWL0",129 ,0)
  19424    ;
  19425   "RTN","RCD PEWL0",130 ,0)
  19426    ;           ^TMP("RC ERA_PVW")        - Gl obal array  of prefer red view s ettings
  19427   "RTN","RCD PEWL0",131 ,0)
  19428    ;           ^TMP("RC ERA_PARAMS ")    - Gl obal array  of curren tly in use  defaults
  19429   "RTN","RCD PEWL0",132 ,0)
  19430    ; Returns : 1 - User  has prefe rred view  if SOURCE  is 'MO' or  is using
  19431   "RTN","RCD PEWL0",133 ,0)
  19432    ;               thei r preferre d view if  SOURCE is  'CV'
  19433   "RTN","RCD PEWL0",134 ,0)
  19434    ;           0 - User  is not us ing their  preferred  view
  19435   "RTN","RCD PEWL0",135 ,0)
  19436    ;          -1 - User  does not  have a pre ferred vie
  19437   "RTN","RCD PEWL0",136 ,0)
  19438    I SOURCE= "MO" Q $S( $D(^TMP("R CERA_PVW", $J)):1,1:- 1)
  19439   "RTN","RCD PEWL0",137 ,0)
  19440    Q:'$D(^TM P("RCERA_P VW",$J)) - 1  ; No st ored prefe rred view
  19441   "RTN","RCD PEWL0",138 ,0)
  19442    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCPOST"))' =$G(^TMP(" RCERA_PVW" ,$J,"RCPOS T")) 0
  19443   "RTN","RCD PEWL0",139 ,0)
  19444    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCAUTOP")) '=$G(^TMP( "RCERA_PVW ",$J,"RCAU TOP")) 0
  19445   "RTN","RCD PEWL0",140 ,0)
  19446    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCMATCH")) '=$G(^TMP( "RCERA_PVW ",$J,"RCMA TCH")) 0
  19447   "RTN","RCD PEWL0",141 ,0)
  19448    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCTYPE"))' =$G(^TMP(" RCERA_PVW" ,$J,"RCTYP E")) 0
  19449   "RTN","RCD PEWL0",142 ,0)
  19450    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCPAYR"))' =$G(^TMP(" RCERA_PVW" ,$J,"RCPAY R")) 0
  19451   "RTN","RCD PEWL0",143 ,0)
  19452    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCPAYMNT") )'=$G(^TMP ("RCERA_PV W",$J,"RCP AYMNT")) 0   ; PRCA*4 .5*321
  19453   "RTN","RCD PEWL0",144 ,0)
  19454    Q:$G(^TMP ("RCERA_PA RAMS",$J," RCAPSTA")) '=$G(^TMP( "RCERA_PVW ",$J,"RCAP STA")) 0 ;  PRCA*4.5* 326
  19455   "RTN","RCD PEWL0",145 ,0)
  19456    Q 1
  19457   "RTN","RCD PEWL0",146 ,0)
  19458    ;
  19459   "RTN","RCD PEWL0",147 ,0)
  19460   ASKUVW() ; EP from PA RAMS^RCDPE WLA, PARAM S^RCDPEAA1
  19461   "RTN","RCD PEWL0",148 ,0)
  19462    ; Prompts  the user  to see if  they want  to use the ir preferr ed view
  19463   "RTN","RCD PEWL0",149 ,0)
  19464    ; PRCA*4. 5*317 adde d function
  19465   "RTN","RCD PEWL0",150 ,0)
  19466    ; Input:    None
  19467   "RTN","RCD PEWL0",151 ,0)
  19468    ; Returns : 1 - User  wants to  use their  preferred  view
  19469   "RTN","RCD PEWL0",152 ,0)
  19470    ;           0 - User  does not  want to us e their pr eferred vi ew
  19471   "RTN","RCD PEWL0",153 ,0)
  19472    ;          -1 - User  typed '^'
  19473   "RTN","RCD PEWL0",154 ,0)
  19474    N DIR,DTO UT,DUOUT
  19475   "RTN","RCD PEWL0",155 ,0)
  19476    S DIR(0)= "Y"
  19477   "RTN","RCD PEWL0",156 ,0)
  19478    S DIR("A" )="Use pre ferred vie w"
  19479   "RTN","RCD PEWL0",157 ,0)
  19480    S DIR("B" )="N"
  19481   "RTN","RCD PEWL0",158 ,0)
  19482    W !
  19483   "RTN","RCD PEWL0",159 ,0)
  19484    D ^DIR
  19485   "RTN","RCD PEWL0",160 ,0)
  19486    I $D(DTOU T)!$D(DUOU T) Q -1
  19487   "RTN","RCD PEWL0",161 ,0)
  19488    Q:Y 1   ;  response  is YES
  19489   "RTN","RCD PEWL0",162 ,0)
  19490    Q 0
  19491   "RTN","RCD PEWL0",163 ,0)
  19492    ;
  19493   "RTN","RCD PEWL0",164 ,0)
  19494   SAVEPVW ;  Option to  save as Us er Preferr ed View
  19495   "RTN","RCD PEWL0",165 ,0)
  19496    ; PRCA*4. 5*317 adde d subrouti ne
  19497   "RTN","RCD PEWL0",166 ,0)
  19498    ; Input:    ^TMP("RC ERA_PARAMS ")    - Gl obal array  of curren t worklist  settings
  19499   "RTN","RCD PEWL0",167 ,0)
  19500    ; Output    Current  worklist s ettings se t as prefe rred view  (potential ly)
  19501   "RTN","RCD PEWL0",168 ,0)
  19502    N DIR,DTO UT,DUOUT,R CERROR,XX
  19503   "RTN","RCD PEWL0",169 ,0)
  19504    K DIR
  19505   "RTN","RCD PEWL0",170 ,0)
  19506    S DIR(0)= "YA",DIR(" B")="NO"
  19507   "RTN","RCD PEWL0",171 ,0)
  19508    S DIR("A" )="Do you  want to sa ve this as  your pref erred view  (Y/N)? "
  19509   "RTN","RCD PEWL0",172 ,0)
  19510    W !
  19511   "RTN","RCD PEWL0",173 ,0)
  19512    D ^DIR
  19513   "RTN","RCD PEWL0",174 ,0)
  19514    Q:Y'=1
  19515   "RTN","RCD PEWL0",175 ,0)
  19516    S XX=^TMP ("RCERA_PA RAMS",$J," RCPOST")
  19517   "RTN","RCD PEWL0",176 ,0)
  19518    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ POSTING_ST ATUS",XX,. RCERROR)
  19519   "RTN","RCD PEWL0",177 ,0)
  19520    S XX=^TMP ("RCERA_PA RAMS",$J," RCAUTOP")
  19521   "RTN","RCD PEWL0",178 ,0)
  19522    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ AUTO_POSTI NG",XX,.RC ERROR)
  19523   "RTN","RCD PEWL0",179 ,0)
  19524    S XX=^TMP ("RCERA_PA RAMS",$J," RCMATCH")
  19525   "RTN","RCD PEWL0",180 ,0)
  19526    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA- EFT_MATCH_ STATUS",XX ,.RCERROR)
  19527   "RTN","RCD PEWL0",181 ,0)
  19528    S XX=^TMP ("RCERA_PA RAMS",$J," RCTYPE")
  19529   "RTN","RCD PEWL0",182 ,0)
  19530    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ CLAIM_TYPE ",XX,.RCER ROR)
  19531   "RTN","RCD PEWL0",183 ,0)
  19532    S XX=$TR( ^TMP("RCER A_PARAMS", $J,"RCPAYR "),"^",";" )
  19533   "RTN","RCD PEWL0",184 ,0)
  19534    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ALL_ PAYERS/RAN GE_OF_PAYE RS",XX,.RC ERROR)
  19535   "RTN","RCD PEWL0",185 ,0)
  19536    S XX=^TMP ("RCERA_PA RAMS",$J," RCPAYMNT")                                                    ; P RCA*4.5*32 1
  19537   "RTN","RCD PEWL0",186 ,0)
  19538    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","ERA_ PAYMENT_TY PE",XX,.RC ERROR) ; P RCA*4.5*32 1
  19539   "RTN","RCD PEWL0",187 ,0)
  19540    S XX=$TR( ^TMP("RCER A_PARAMS", $J,"RCAPST A"),"^","; ") ; PRCA* 4.5*326
  19541   "RTN","RCD PEWL0",188 ,0)
  19542    D EN^XPAR (DUZ_";VA( 200,","RCD PE EDI LOC KBOX WORKL IST","AUTO -POST_STAT US",XX,.RC ERROR) ; P RCA*4.5*32 6
  19543   "RTN","RCD PEWL0",189 ,0)
  19544    ;
  19545   "RTN","RCD PEWL0",190 ,0)
  19546    K ^TMP("R CERA_PVW", $J)
  19547   "RTN","RCD PEWL0",191 ,0)
  19548    M ^TMP("R CERA_PVW", $J)=^TMP(" RCERA_PARA MS",$J)  ;  capture n ew preferr ed setting s for comp arison
  19549   "RTN","RCD PEWL0",192 ,0)
  19550    Q
  19551   "RTN","RCD PEWL0",193 ,0)
  19552    ;
  19553   "RTN","RCD PEWL0",194 ,0)
  19554   DTR() ; Da te Range S election
  19555   "RTN","RCD PEWL0",195 ,0)
  19556    ; Input:    ^TMP("RC ERA_PARAMS ",$J,"RCDT ") - Curre nt selecte d Date Ran ge (if any )
  19557   "RTN","RCD PEWL0",196 ,0)
  19558    ; Output:   ^TMP("RC ERA_PARAMS ",$J,"RCDT ") - Updat ed Selecte d Date Ran ge
  19559   "RTN","RCD PEWL0",197 ,0)
  19560    ; Returns : 1 if use r quit or  timed out,  0 otherwi se
  19561   "RTN","RCD PEWL0",198 ,0)
  19562   DTR1 ;
  19563   "RTN","RCD PEWL0",199 ,0)
  19564    N DIR,DTO UT,DTQUIT, DUOUT,Y,FR OM,TO,RCDT RNG
  19565   "RTN","RCD PEWL0",200 ,0)
  19566    S ^TMP("R CERA_PARAM S",$J,"RCD T")="0^"_D T
  19567   "RTN","RCD PEWL0",201 ,0)
  19568    K DIR S D IR(0)="YA"
  19569   "RTN","RCD PEWL0",202 ,0)
  19570    S DIR("A" )="Limit t he selecti on to a da te range w hen the ER A was rece ived?: "
  19571   "RTN","RCD PEWL0",203 ,0)
  19572    S DIR("B" )="NO"
  19573   "RTN","RCD PEWL0",204 ,0)
  19574    S DIR("?" )="Enter Y ES to spec ify a date  range fil ter."
  19575   "RTN","RCD PEWL0",205 ,0)
  19576    W !
  19577   "RTN","RCD PEWL0",206 ,0)
  19578    D ^DIR
  19579   "RTN","RCD PEWL0",207 ,0)
  19580    I $D(DTOU T)!$D(DUOU T) Q 1
  19581   "RTN","RCD PEWL0",208 ,0)
  19582    I Y D  G: DTQUIT DTR 1
  19583   "RTN","RCD PEWL0",209 ,0)
  19584    . S DTQUI T=0
  19585   "RTN","RCD PEWL0",210 ,0)
  19586    . S FROM= $P($G(^TMP ("RCERA_PA RAMS",$J," RCDT")),"^ ",1)
  19587   "RTN","RCD PEWL0",211 ,0)
  19588    . S TO=$P ($G(^TMP(" RCERA_PARA MS",$J,"RC DT")),"^", 2)
  19589   "RTN","RCD PEWL0",212 ,0)
  19590    . W !
  19591   "RTN","RCD PEWL0",213 ,0)
  19592    . S RCDTR NG=$$DTRAN GE(FROM,TO )
  19593   "RTN","RCD PEWL0",214 ,0)
  19594    . I RCDTR NG="^" S D TQUIT=1 Q
  19595   "RTN","RCD PEWL0",215 ,0)
  19596    . S ^TMP( "RCERA_PAR AMS",$J,"R CDT")=RCDT RNG
  19597   "RTN","RCD PEWL0",216 ,0)
  19598    Q 0
  19599   "RTN","RCD PEWL0",217 ,0)
  19600    ;
  19601   "RTN","RCD PEWL0",218 ,0)
  19602   DTRANGE(DE FFROM,DEFT O) ; Asks  for and re turns a Da te Range
  19603   "RTN","RCD PEWL0",219 ,0)
  19604    ; Input:  DEFFROM -  Default FR OM date
  19605   "RTN","RCD PEWL0",220 ,0)
  19606    ;         DEFTO   -  Default TO  date
  19607   "RTN","RCD PEWL0",221 ,0)
  19608    ;Output:  From_Date^ To_Date (Y YYMMDD^YYY DDMM) or " ^" (timeou t or ^ ent ered)
  19609   "RTN","RCD PEWL0",222 ,0)
  19610    ;
  19611   "RTN","RCD PEWL0",223 ,0)
  19612    N DIR,Y,D TOUT,DUOUT ,RCDFR,STA RT
  19613   "RTN","RCD PEWL0",224 ,0)
  19614    S RCQUIT= 0
  19615   "RTN","RCD PEWL0",225 ,0)
  19616    S DIR(0)= "DAE^:"_DT _":E"
  19617   "RTN","RCD PEWL0",226 ,0)
  19618    S DIR("A" )="Earlies t date: "
  19619   "RTN","RCD PEWL0",227 ,0)
  19620    S DIR("?" )="Enter t he start o f the date  range."
  19621   "RTN","RCD PEWL0",228 ,0)
  19622    S:($G(DEF FROM)) DIR ("B")=$$FM TE^XLFDT(D EFFROM,2)
  19623   "RTN","RCD PEWL0",229 ,0)
  19624    D ^DIR
  19625   "RTN","RCD PEWL0",230 ,0)
  19626    I $D(DTOU T)!$D(DUOU T) Q "^"
  19627   "RTN","RCD PEWL0",231 ,0)
  19628    S RCDFR=Y ,START=$$F MTE^XLFDT( RCDFR,"2DZ ")
  19629   "RTN","RCD PEWL0",232 ,0)
  19630    K DIR
  19631   "RTN","RCD PEWL0",233 ,0)
  19632    S DIR(0)= "DAE^"_RCD FR_":"_DT_ ":E"
  19633   "RTN","RCD PEWL0",234 ,0)
  19634    S DIR("A" )="Latest  date: "
  19635   "RTN","RCD PEWL0",235 ,0)
  19636    S DIR("?" ,1)="Enter  the end o f the date  range. Th e ending d ate must b e greater  than "
  19637   "RTN","RCD PEWL0",236 ,0)
  19638    S DIR("?" )="or equa l to "_STA RT_"."
  19639   "RTN","RCD PEWL0",237 ,0)
  19640    S:($G(DEF TO)) DIR(" B")=$$FMTE ^XLFDT(DEF TO,2)
  19641   "RTN","RCD PEWL0",238 ,0)
  19642    D ^DIR
  19643   "RTN","RCD PEWL0",239 ,0)
  19644    I $D(DTOU T)!$D(DUOU T) Q "^"
  19645   "RTN","RCD PEWL0",240 ,0)
  19646    Q (RCDFR_ "^"_Y)
  19647   "RTN","RCD PEWL0",241 ,0)
  19648    ;
  19649   "RTN","RCD PEWL0",242 ,0)
  19650   SPLIT ; Sp lit line i n ERA list
  19651   "RTN","RCD PEWL0",243 ,0)
  19652    ; input -  RCSCR = i en of 344. 49 and 344 .4
  19653   "RTN","RCD PEWL0",244 ,0)
  19654    N RCLINE, RCZ,RCDA,Q ,Q0,Z,Z0,D IR,X,Y,CT, L,L1,RCONE ,RCQUIT
  19655   "RTN","RCD PEWL0",245 ,0)
  19656    D FULL^VA LM1
  19657   "RTN","RCD PEWL0",246 ,0)
  19658    I $S($P($ G(^RCY(344 .4,RCSCR,4 )),U,2)]"" :1,1:0) D  NOEDIT^RCD PEWLP G SP LITQ   ;pr ca*4.5*298   auto-pos ted ERAs c annot ente r Split/Ed it action
  19659   "RTN","RCD PEWL0",247 ,0)
  19660    I $G(RCSC R("NOEDIT" )) D NOEDI T^RCDPEWL  G SPLITQ
  19661   "RTN","RCD PEWL0",248 ,0)
  19662    W !!,"Sel ect the en try that h as a line  you need t o Split/Ed it",!
  19663   "RTN","RCD PEWL0",249 ,0)
  19664    D SEL^RCD PEWL(.RCDA )
  19665   "RTN","RCD PEWL0",250 ,0)
  19666    S Z=+$O(R CDA(0)) G: '$G(RCDA(Z )) SPLITQ
  19667   "RTN","RCD PEWL0",251 ,0)
  19668    S RCLINE= +RCDA(Z),Z 0=+$O(^TMP ("RCDPE-EO B_WLDX",$J ,Z_".999") ,-1)
  19669   "RTN","RCD PEWL0",252 ,0)
  19670    S RCZ=Z F   S RCZ=$O (^TMP("RCD PE-EOB_WLD X",$J,RCZ) ) Q:'RCZ!( RCZ\1'=Z)   D
  19671   "RTN","RCD PEWL0",253 ,0)
  19672    . S Q=$P( $G(^TMP("R CDPE-EOB_W LDX",$J,RC Z)),U,2)
  19673   "RTN","RCD PEWL0",254 ,0)
  19674    . Q:'Q
  19675   "RTN","RCD PEWL0",255 ,0)
  19676    . S RCZ(R CZ)=Q
  19677   "RTN","RCD PEWL0",256 ,0)
  19678    . S Q0=0  F  S Q0=$O (^RCY(344. 49,RCSCR,1 ,Q,1,Q0))  Q:'Q0  I " 01"[$P($G( ^(Q0,0)),U ,2) K RCZ( RCZ) Q
  19679   "RTN","RCD PEWL0",257 ,0)
  19680    I '$O(RCZ (0)) D  G  SPLITQ
  19681   "RTN","RCD PEWL0",258 ,0)
  19682    . S DIR(0 )="EA",DIR ("A",1)="T his entry  has no lin es availab le to Edit /Split",DI R("A")="PR ESS RETURN  TO CONTIN UE " W ! D  ^DIR K DI R
  19683   "RTN","RCD PEWL0",259 ,0)
  19684    S RCQUIT= 0
  19685   "RTN","RCD PEWL0",260 ,0)
  19686    I $P($G(^ RCY(344.49 ,RCSCR,1,R CLINE,0)), U,13) D  G :RCQUIT SP LITQ
  19687   "RTN","RCD PEWL0",261 ,0)
  19688    . S DIR(" A",1)="WAR NING!  Thi s line has  already b een VERIFI ED",DIR("A ")="Are yo u sure you  want to c ontinue?:  ",DIR(0)=" YA",DIR("B ")="NO" W  ! D ^DIR K  DIR
  19689   "RTN","RCD PEWL0",262 ,0)
  19690    . I Y'=1  S RCQUIT=1
  19691   "RTN","RCD PEWL0",263 ,0)
  19692    S CT=0,CT =CT+1,DIR( "?",CT)="E nter the l ine # that  you want  to split o r edit:",R CONE=1
  19693   "RTN","RCD PEWL0",264 ,0)
  19694    S L=Z F   S L=$O(RCZ (L)) Q:'L   D
  19695   "RTN","RCD PEWL0",265 ,0)
  19696    . S L1=+$ G(^TMP("RC DPE-EOB_WL DX",$J,L))
  19697   "RTN","RCD PEWL0",266 ,0)
  19698    . S CT=CT +1
  19699   "RTN","RCD PEWL0",267 ,0)
  19700    . S DIR(" ?",CT)=$G( ^TMP("RCDP E-EOB_WL", $J,L1,0)), CT=CT+1,DI R("?",CT)= $G(^TMP("R CDPE-EOB_W L",$J,L1+1 ,0)) S RCO NE(1)=$S(R CONE:L,1:" ") S RCONE =0
  19701   "RTN","RCD PEWL0",268 ,0)
  19702    S DIR("?" )=" ",Y=-1
  19703   "RTN","RCD PEWL0",269 ,0)
  19704    I $G(RCON E(1)) S Y= +RCONE(1)  K DIR G:'Y  SPLITQ
  19705   "RTN","RCD PEWL0",270 ,0)
  19706    I '$G(RCO NE(1)) D   K DIR I $D (DTOUT)!$D (DUOUT)!(Y \1'=Z) G S PLITQ
  19707   "RTN","RCD PEWL0",271 ,0)
  19708    . F  S DI R(0)="NAO^ "_(Z+.001) _":"_Z0_": 3",DIR("A" )="Which l ine of ent ry "_Z_" d o you want  to Split/ Edit?: " S :$G(RCONE( 1))'="" DI R("B")=RCO NE(1) D ^D IR Q:'Y!$D (DUOUT)!$D (DTOUT)  D   Q:Y>0
  19709   "RTN","RCD PEWL0",272 ,0)
  19710    .. I '$D( ^TMP("RCDP E-EOB_WLDX ",$J,Y)) W  !!,"Line  "_Y_" does  NOT exist  - TRY AGA IN",! S Y= -1 Q
  19711   "RTN","RCD PEWL0",273 ,0)
  19712    .. I '$D( RCZ(Y)) W  !!,"Line " _Y_" has b een used i n a DISTRI BUTE ADJ a ction and  can't be e dited",! S  Y=-1 Q
  19713   "RTN","RCD PEWL0",274 ,0)
  19714    .. S Q=+$ O(^RCY(344 .49,RCSCR, 1,"B",Y,0) )
  19715   "RTN","RCD PEWL0",275 ,0)
  19716    ;
  19717   "RTN","RCD PEWL0",276 ,0)
  19718    K ^TMP("R CDPE_SPLIT _REBLD",$J )
  19719   "RTN","RCD PEWL0",277 ,0)
  19720    D SPLIT^R CDPEWL3(RC SCR,+Y)
  19721   "RTN","RCD PEWL0",278 ,0)
  19722    I $G(^TMP ("RCDPE_SP LIT_REBLD" ,$J)) K ^T MP("RCDPE_ SPLIT_REBL D",$J) D B LD^RCDPEWL 1($G(^TMP( $J,"RC_SOR TPARM")))
  19723   "RTN","RCD PEWL0",279 ,0)
  19724    ;
  19725   "RTN","RCD PEWL0",280 ,0)
  19726   SPLITQ S V ALMBCK="R"
  19727   "RTN","RCD PEWL0",281 ,0)
  19728    Q
  19729   "RTN","RCD PEWL0",282 ,0)
  19730    ;
  19731   "RTN","RCD PEWL0",283 ,0)
  19732   PRTERA ; E P from men u option V iew/Print  ERA (VP) [ RCDPE VIEW /PRINT ERA ]
  19733   "RTN","RCD PEWL0",284 ,0)
  19734    ; View th e selected  ERA in a  listman te mplate
  19735   "RTN","RCD PEWL0",285 ,0)
  19736    ; Input:  RCSCR - IE N of the E RA to be v iewed
  19737   "RTN","RCD PEWL0",286 ,0)
  19738    N DIC,RCS CR,X,Y
  19739   "RTN","RCD PEWL0",287 ,0)
  19740    S DIC="^R CY(344.4," ,DIC(0)="A EMQ"
  19741   "RTN","RCD PEWL0",288 ,0)
  19742    D ^DIC
  19743   "RTN","RCD PEWL0",289 ,0)
  19744    Q:Y'>0
  19745   "RTN","RCD PEWL0",290 ,0)
  19746    S RCSCR=+ Y
  19747   "RTN","RCD PEWL0",291 ,0)
  19748    D PRERA1
  19749   "RTN","RCD PEWL0",292 ,0)
  19750    Q
  19751   "RTN","RCD PEWL0",293 ,0)
  19752    ;
  19753   "RTN","RCD PEWL0",294 ,0)
  19754   PRERA ; RC SCR is ass umed to be  defined
  19755   "RTN","RCD PEWL0",295 ,0)
  19756    D FULL^VA LM1 ; Prot ocol entry
  19757   "RTN","RCD PEWL0",296 ,0)
  19758   PRERA1 ; O ption entr y
  19759   "RTN","RCD PEWL0",297 ,0)
  19760    N DIR,X,Y ,RCERADET, RCLSTMGR,P OP,ZTRTN,Z TSAVE,ZTDE SC,%ZIS ;  PRCA*4.5*3 32
  19761   "RTN","RCD PEWL0",298 ,0)
  19762    D EXCWARN ^RCDPEWLP( RCSCR)
  19763   "RTN","RCD PEWL0",299 ,0)
  19764    S DIR("?" ,1)="Inclu ding expan ded detail  will sign ificantly  increase t he size of  this repo rt",DIR("? ",2)="IF Y OU CHOOSE  TO INCLUDE  IT, ALL P AYMENT DET AILS FOR E ACH EEOB W ILL BE"
  19765   "RTN","RCD PEWL0",300 ,0)
  19766    S DIR("?" )="listed.   If you w ant just s ummary dat a for each  EEOB, do  NOT includ e it."
  19767   "RTN","RCD PEWL0",301 ,0)
  19768    S DIR(0)= "YA",DIR(" A")="Do yo u want to  include ex panded EEO B detail?:  ",DIR("B" )="NO"
  19769   "RTN","RCD PEWL0",302 ,0)
  19770    W !
  19771   "RTN","RCD PEWL0",303 ,0)
  19772    D ^DIR
  19773   "RTN","RCD PEWL0",304 ,0)
  19774    K DIR
  19775   "RTN","RCD PEWL0",305 ,0)
  19776    I $D(DUOU T)!$D(DTOU T) G PRERA Q
  19777   "RTN","RCD PEWL0",306 ,0)
  19778    S RCERADE T=+Y
  19779   "RTN","RCD PEWL0",307 ,0)
  19780    S RCLSTMG R=$$ASKLM^ RCDPEARL(1 )           ; PRCA*4. 5*332
  19781   "RTN","RCD PEWL0",308 ,0)
  19782    I RCLSTMG R=-1 G PRE RAQ                    ; PRCA*4. 5*332
  19783   "RTN","RCD PEWL0",309 ,0)
  19784    I RCLSTMG R D VPERA( RCSCR,RCER ADET,1) Q   ; PRCA*4. 5*332
  19785   "RTN","RCD PEWL0",310 ,0)
  19786    S %ZIS="Q M" D ^%ZIS  G:POP PRE RAQ
  19787   "RTN","RCD PEWL0",311 ,0)
  19788    I $D(IO(" Q")) D  G  PRERAQ
  19789   "RTN","RCD PEWL0",312 ,0)
  19790    . S ZTRTN ="VPERA^RC DPEWL0("_R CSCR_","_R CERADET_", 0)",ZTDESC ="AR - Pri nt ERA Fro m Worklist "
  19791   "RTN","RCD PEWL0",313 ,0)
  19792    . D ^%ZTL OAD
  19793   "RTN","RCD PEWL0",314 ,0)
  19794    . W !!,$S ($D(ZTSK): "Your task  # "_ZTSK_ " has been  queued.", 1:"Unable  to queue t his job.")
  19795   "RTN","RCD PEWL0",315 ,0)
  19796    . K ZTSK, IO("Q") D  HOME^%ZIS
  19797   "RTN","RCD PEWL0",316 ,0)
  19798    U IO
  19799   "RTN","RCD PEWL0",317 ,0)
  19800    D VPERA(R CSCR,RCERA DET,0) ; P RCA*4.5*33 2
  19801   "RTN","RCD PEWL0",318 ,0)
  19802    Q
  19803   "RTN","RCD PEWL0",319 ,0)
  19804    ;
  19805   "RTN","RCD PEWL0",320 ,0)
  19806   VPERA(RCSC R,RCERADET ,LSTMGR) ;  Queued en try
  19807   "RTN","RCD PEWL0",321 ,0)
  19808    ; Input:  RCSCR - IE N of ERA t o be viewe d (#344.4)
  19809   "RTN","RCD PEWL0",322 ,0)
  19810    ; RCERADE T - 1 if i nclusion o f all EOB  details fr om file 36 1.1 is
  19811   "RTN","RCD PEWL0",323 ,0)
  19812    ; desired , 0 if not
  19813   "RTN","RCD PEWL0",324 ,0)
  19814    ; LSTMGR  - 1 displa y in list  manager, 0  otherwise
  19815   "RTN","RCD PEWL0",325 ,0)
  19816    N RC,RCDI Q,RCDIQ1,R CDIQ2,RCDO T,RCPG,RCS CR1,RC3611 ,RCXM1,RCZ ,RC3611,XX ,Z,Z0
  19817   "RTN","RCD PEWL0",326 ,0)
  19818    K ^TMP($J ,"RC_SUMRA W"),^TMP($ J,"RC_SUMO UT"),^TMP( $J,"RC_SUM ALL")
  19819   "RTN","RCD PEWL0",327 ,0)
  19820    S (RCSTOP ,RCPG)=0,R CDOT="",$P (RCDOT,"." ,79)=""
  19821   "RTN","RCD PEWL0",328 ,0)
  19822    D GETS^DI Q(344.4,RC SCR_",","* ","IEN","R CDIQ")
  19823   "RTN","RCD PEWL0",329 ,0)
  19824    D TXT0^RC DPEX31(RCS CR,.RCDIQ, .RCXM1,.RC ) ; Get to p level 0- node capti oned flds
  19825   "RTN","RCD PEWL0",330 ,0)
  19826    I $O(^RCY (344.4,RCS CR,2,0)) S  RC=RC+1,R CXM1(RC)="   **ERA LE VEL ADJUST MENTS**"
  19827   "RTN","RCD PEWL0",331 ,0)
  19828    S RCSCR1= 0 F  S RCS CR1=$O(^RC Y(344.4,RC SCR,2,RCSC R1)) Q:'RC SCR1  D
  19829   "RTN","RCD PEWL0",332 ,0)
  19830    . K RCDIQ 2
  19831   "RTN","RCD PEWL0",333 ,0)
  19832    . D GETS^ DIQ(344.42 ,RCSCR1_", "_RCSCR_", ","*","IEN ","RCDIQ2" )
  19833   "RTN","RCD PEWL0",334 ,0)
  19834    . D TXT2^ RCDPEX31(R CSCR,RCSCR 1,.RCDIQ2, .RCXM1,.RC ) ; Get to p level ER A adjs
  19835   "RTN","RCD PEWL0",335 ,0)
  19836    S RCSCR1= 0 F  S RCS CR1=$O(^RC Y(344.4,RC SCR,1,RCSC R1)) Q:'RC SCR1  D
  19837   "RTN","RCD PEWL0",336 ,0)
  19838    . K RCDIQ 1
  19839   "RTN","RCD PEWL0",337 ,0)
  19840    . D GETS^ DIQ(344.41 ,RCSCR1_", "_RCSCR_", ","*","IE" ,"RCDIQ1")   ;PRCA*4. 5*298  nee d to retri eve all fi elds even  if null  ( changed "I EN" to "IE ")
  19841   "RTN","RCD PEWL0",338 ,0)
  19842    . D TXT00 ^RCDPEX31( RCSCR,RCSC R1,.RCDIQ1 ,.RCXM1,.R C)
  19843   "RTN","RCD PEWL0",339 ,0)
  19844    . ;HIPAA  5010
  19845   "RTN","RCD PEWL0",340 ,0)
  19846    . N PNAME 4
  19847   "RTN","RCD PEWL0",341 ,0)
  19848    . S PNAME 4=$$PNM4^R CDPEWL1(RC SCR,RCSCR1 )
  19849   "RTN","RCD PEWL0",342 ,0)
  19850    . I $L(PN AME4)<32 D
  19851   "RTN","RCD PEWL0",343 ,0)
  19852    . .S RC=R C+1,RCXM1( RC-1)=$E(" PATIENT: " _PNAME4_$J ("",41),1, 41)_"CLAIM  #: "_$$BI LLREF^RCDP ESR0(RCSCR ,RCSCR1),R CXM1(RC)="  "
  19853   "RTN","RCD PEWL0",344 ,0)
  19854    . I $L(PN AME4)>31 D
  19855   "RTN","RCD PEWL0",345 ,0)
  19856    . .S RC=R C+1,RCXM1( RC-1)=$J(" ",41)_"CLA IM #: "_$$ BILLREF^RC DPESR0(RCS CR,RCSCR1)
  19857   "RTN","RCD PEWL0",346 ,0)
  19858    . .S RC=R C+1,RCXM1( RC-1)=$E(" PATIENT: " _PNAME4,1, 78),RCXM1( RC)=" "
  19859   "RTN","RCD PEWL0",347 ,0)
  19860    . D PROV^ RCDPEWLD(R CSCR,RCSCR 1,.RCXM1,. RC)
  19861   "RTN","RCD PEWL0",348 ,0)
  19862    . S RC361 1=$P($G(^R CY(344.4,R CSCR,1,RCS CR1,0)),U, 2)
  19863   "RTN","RCD PEWL0",349 ,0)
  19864    . I RCERA DET D
  19865   "RTN","RCD PEWL0",350 ,0)
  19866    .. I 'RC3 611 D  Q
  19867   "RTN","RCD PEWL0",351 ,0)
  19868    ... D DIS P^RCDPESR0 ("^RCY(344 .4,"_RCSCR _",1,"_RCS CR1_",1)", "^TMP($J," "RC_SUMRAW "")",1,"^T MP($J,""RC _SUMOUT"") ",75,1)
  19869   "RTN","RCD PEWL0",352 ,0)
  19870    ..;
  19871   "RTN","RCD PEWL0",353 ,0)
  19872    .. E  D   ; Detail r ecord is i n 361.1
  19873   "RTN","RCD PEWL0",354 ,0)
  19874    ... K ^TM P("PRCA_EO B",$J)
  19875   "RTN","RCD PEWL0",355 ,0)
  19876    ... D GET EOB^IBCECS A6(RC3611, 2)
  19877   "RTN","RCD PEWL0",356 ,0)
  19878    ... I $O( ^IBM(361.1 ,RC3611,"E RR",0)) D  GETERR^RCD PEDS(RC361 1,+$O(^TMP ("PRCA_EOB ",$J,RC361 1," "),-1) ) ; get fi ling error s
  19879   "RTN","RCD PEWL0",357 ,0)
  19880    ... S Z=0  F  S Z=$O (^TMP("PRC A_EOB",$J, RC3611,Z))  Q:'Z  S R C=RC+1,^TM P($J,"RC_S UMOUT",RC) =$G(^TMP(" PRCA_EOB", $J,RC3611, Z))
  19881   "RTN","RCD PEWL0",358 ,0)
  19882    ... S RC= RC+2,^TMP( $J,"RC_SUM OUT",RC-1) =" ",^TMP( $J,"RC_SUM OUT",RC)="  "
  19883   "RTN","RCD PEWL0",359 ,0)
  19884    ... K ^TM P("PRCA_EO B",$J)
  19885   "RTN","RCD PEWL0",360 ,0)
  19886    . I $D(RC DIQ1(344.4 1,RCSCR1_" ,"_RCSCR_" ,",2)) D
  19887   "RTN","RCD PEWL0",361 ,0)
  19888    .. S RC=R C+1,RCXM1( RC)="  **E XCEPTION R ESOLUTION  LOG DATA** "
  19889   "RTN","RCD PEWL0",362 ,0)
  19890    .. S Z=0  F  S Z=$O( RCDIQ1(344 .41,RCSCR1 _","_RCSCR _",",2,Z))  Q:'Z  S R C=RC+1,RCX M1(RC)=RCD IQ1(344.41 ,RCSCR1_", "_RCSCR_", ",2,Z)
  19891   "RTN","RCD PEWL0",363 ,0)
  19892    . S RC=RC +1,RCXM1(R C)=" "
  19893   "RTN","RCD PEWL0",364 ,0)
  19894    . S Z0=+$ O(^TMP($J, "RC_SUMALL "," "),-1)
  19895   "RTN","RCD PEWL0",365 ,0)
  19896    . S Z=0 F   S Z=$O(R CXM1(Z)) Q :'Z  S Z0= Z0+1,^TMP( $J,"RC_SUM ALL",Z0)=R CXM1(Z)
  19897   "RTN","RCD PEWL0",366 ,0)
  19898    . K RCXM1  S RC=0
  19899   "RTN","RCD PEWL0",367 ,0)
  19900    . S Z=0 F   S Z=$O(^ TMP($J,"RC _SUMOUT",Z )) Q:'Z  S  Z0=Z0+1,^ TMP($J,"RC _SUMALL",Z 0)=$G(^TMP ($J,"RC_SU MOUT",Z))
  19901   "RTN","RCD PEWL0",368 ,0)
  19902    I LSTMGR  D DOLSTMAN ,PRERAQ Q   ; PRCA*4. 5*332
  19903   "RTN","RCD PEWL0",369 ,0)
  19904    S RCSTOP= 0,Z=""
  19905   "RTN","RCD PEWL0",370 ,0)
  19906    F  S Z=$O (^TMP($J," RC_SUMALL" ,Z)) Q:'Z   D  Q:RCST OP
  19907   "RTN","RCD PEWL0",371 ,0)
  19908    . I $D(ZT QUEUED),$$ S^%ZTLOAD  S (RCSTOP, ZTSTOP)=1  K ZTREQ I  +$G(RCPG)  W !!,"***T ASK STOPPE D BY USER* **" Q
  19909   "RTN","RCD PEWL0",372 ,0)
  19910    . I 'RCPG !(($Y+5)>I OSL) D  I  RCSTOP Q
  19911   "RTN","RCD PEWL0",373 ,0)
  19912    .. D:RCPG  ASK(.RCST OP) I RCST OP Q
  19913   "RTN","RCD PEWL0",374 ,0)
  19914    .. D HDR( .RCPG)
  19915   "RTN","RCD PEWL0",375 ,0)
  19916    . W !,$G( ^TMP($J,"R C_SUMALL", Z))
  19917   "RTN","RCD PEWL0",376 ,0)
  19918    ;
  19919   "RTN","RCD PEWL0",377 ,0)
  19920    I 'RCSTOP ,RCPG D AS K(.RCSTOP)
  19921   "RTN","RCD PEWL0",378 ,0)
  19922    ;
  19923   "RTN","RCD PEWL0",379 ,0)
  19924    I $D(ZTQU EUED) S ZT REQ="@"
  19925   "RTN","RCD PEWL0",380 ,0)
  19926    I '$D(ZTQ UEUED) D ^ %ZISC
  19927   "RTN","RCD PEWL0",381 ,0)
  19928    ;
  19929   "RTN","RCD PEWL0",382 ,0)
  19930   PRERAQ K ^ TMP($J,"RC _SUMRAW"), ^TMP($J,"R C_SUMOUT") ,^TMP($J," SUMALL")
  19931   "RTN","RCD PEWL0",383 ,0)
  19932    S VALMBCK ="R"
  19933   "RTN","RCD PEWL0",384 ,0)
  19934    Q
  19935   "RTN","RCD PEWL0",385 ,0)
  19936    ; PRCA*4. 5*332 - Su broutine a dded
  19937   "RTN","RCD PEWL0",386 ,0)
  19938   DOLSTMAN ;  Display t he ERA Det ail in a l istman for mat
  19939   "RTN","RCD PEWL0",387 ,0)
  19940    N HDR
  19941   "RTN","RCD PEWL0",388 ,0)
  19942    S HDR("TI TLE")="VIE W ERA DETA IL"
  19943   "RTN","RCD PEWL0",389 ,0)
  19944    D LMRPT^R CDPEARL(.H DR,$NA(^TM P($J,"RC_S UMALL"))," RCDPE VIEW  ERA DETAI L") ; gene rate ListM an display
  19945   "RTN","RCD PEWL0",390 ,0)
  19946    Q
  19947   "RTN","RCD PEWL0",391 ,0)
  19948    ;
  19949   "RTN","RCD PEWL0",392 ,0)
  19950   HDR(RCPG)  ;Report hd r
  19951   "RTN","RCD PEWL0",393 ,0)
  19952    ; RCPG =  last page  #
  19953   "RTN","RCD PEWL0",394 ,0)
  19954    I RCPG!($ E(IOST,1,2 )="C-") W  @IOF,*13
  19955   "RTN","RCD PEWL0",395 ,0)
  19956    S RCPG=$G (RCPG)+1
  19957   "RTN","RCD PEWL0",396 ,0)
  19958    W !,?5,"E DI LOCKBOX  WORKLIST  - ERA DETA IL",?55,$$ FMTE^XLFDT (DT,2),?70 ,"Page: ", RCPG,!,$TR ($J("",IOM )," ","=")
  19959   "RTN","RCD PEWL0",397 ,0)
  19960    Q
  19961   "RTN","RCD PEWL0",398 ,0)
  19962    ;
  19963   "RTN","RCD PEWL0",399 ,0)
  19964   ASK(RCSTOP ) ;
  19965   "RTN","RCD PEWL0",400 ,0)
  19966    I $E(IOST ,1,2)'["C- " Q
  19967   "RTN","RCD PEWL0",401 ,0)
  19968    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T
  19969   "RTN","RCD PEWL0",402 ,0)
  19970    S DIR(0)= "E" W ! D  ^DIR
  19971   "RTN","RCD PEWL0",403 ,0)
  19972    I ($D(DIR UT))!($D(D UOUT)) S R CSTOP=1 Q
  19973   "RTN","RCD PEWL0",404 ,0)
  19974    Q
  19975   "RTN","RCD PEWL0",405 ,0)
  19976    ;
  19977   "RTN","RCD PEWL7")
  19978   0^18^B2408 34871
  19979   "RTN","RCD PEWL7",1,0 )
  19980   RCDPEWL7 ; ALB/TMK/KM L - EDI LO CKBOX WORK LIST ERA D ISPLAY SCR EEN ;Jun 0 6, 2014@19 :11:19
  19981   "RTN","RCD PEWL7",2,0 )
  19982    ;;4.5;Acc ounts Rece ivable;**2 08,222,269 ,276,298,3 04,318,321 ,326,332** ;Mar 20, 1 995;Build  34
  19983   "RTN","RCD PEWL7",3,0 )
  19984    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  19985   "RTN","RCD PEWL7",4,0 )
  19986    Q
  19987   "RTN","RCD PEWL7",5,0 )
  19988    ;
  19989   "RTN","RCD PEWL7",6,0 )
  19990   BLD(RCSORT ) ; Build  list with  sort crite ria
  19991   "RTN","RCD PEWL7",7,0 )
  19992    ; RCSORT  = the sort  levels to  use to di splay the  data in ^  pieces
  19993   "RTN","RCD PEWL7",8,0 )
  19994    ;  piece  1 = the co des for th e first le vel sort ( sort code; null or -)
  19995   "RTN","RCD PEWL7",9,0 )
  19996    ;  piece  2 = the co des for th e second l evel sort
  19997   "RTN","RCD PEWL7",10, 0)
  19998    ;     sor t code is  the type o f data to  sort by;-  indicates  reverse or der
  19999   "RTN","RCD PEWL7",11, 0)
  20000    N Z,Z1,RC T,RCZ
  20001   "RTN","RCD PEWL7",12, 0)
  20002    S (RCT,VA LMCNT)=0
  20003   "RTN","RCD PEWL7",13, 0)
  20004    I '$D(^TM P($J,"RCER A_LIST"))  D
  20005   "RTN","RCD PEWL7",14, 0)
  20006    . S Z=0 F   S Z=$O(^ TMP("RCDPE -ERA_WLDX" ,$J,Z)) Q: 'Z  S RCZ= $P($G(^(Z) ),U,2) D
  20007   "RTN","RCD PEWL7",15, 0)
  20008    .. I $$FI LTER(RCZ)  S ^TMP($J, "RCERA_LIS T",$$SL(RC Z,$P(RCSOR T,U)),$$SL (RCZ,$P(RC SORT,U,2)) ,RCZ)=""
  20009   "RTN","RCD PEWL7",16, 0)
  20010    . K ^TMP( "RCDPE-ERA _WLDX",$J) ,^TMP("RCD PE-ERA_WL" ,$J)
  20011   "RTN","RCD PEWL7",17, 0)
  20012    ;
  20013   "RTN","RCD PEWL7",18, 0)
  20014    S Z=""
  20015   "RTN","RCD PEWL7",19, 0)
  20016    I RCSORT' ["PN;-" D
  20017   "RTN","RCD PEWL7",20, 0)
  20018    . F  S Z= $O(^TMP($J ,"RCERA_LI ST",Z)) Q: Z=""  S Z1 ="" F  S Z 1=$O(^TMP( $J,"RCERA_ LIST",Z,Z1 )) Q:Z1=""   D EXTRAC T(Z,Z1,.RC T)
  20019   "RTN","RCD PEWL7",21, 0)
  20020    ;
  20021   "RTN","RCD PEWL7",22, 0)
  20022    I $P(RCSO RT,U)["PN; -" D
  20023   "RTN","RCD PEWL7",23, 0)
  20024    . F  S Z= $O(^TMP($J ,"RCERA_LI ST",Z),-1)  Q:Z=""  S  Z1="" F   S Z1=$O(^T MP($J,"RCE RA_LIST",Z ,Z1)) Q:Z1 =""  D EXT RACT(Z,Z1, .RCT)
  20025   "RTN","RCD PEWL7",24, 0)
  20026    ;
  20027   "RTN","RCD PEWL7",25, 0)
  20028    I $P(RCSO RT,U,2)["P N;-" D
  20029   "RTN","RCD PEWL7",26, 0)
  20030    . F  S Z= $O(^TMP($J ,"RCERA_LI ST",Z)) Q: Z=""  S Z1 ="" F  S Z 1=$O(^TMP( $J,"RCERA_ LIST",Z,Z1 ),-1) Q:Z1 =""  D EXT RACT(Z,Z1, .RCT)
  20031   "RTN","RCD PEWL7",27, 0)
  20032    ;
  20033   "RTN","RCD PEWL7",28, 0)
  20034    I '$O(^TM P($J,"RCER A_LIST",0) ) D SET("N o ERAs lef t for your  selection  criteria" )
  20035   "RTN","RCD PEWL7",29, 0)
  20036    K ^TMP($J ,"RCERA_LI ST")
  20037   "RTN","RCD PEWL7",30, 0)
  20038    S ^TMP("R CERA_PARAM S",$J,"SOR T")=RCSORT
  20039   "RTN","RCD PEWL7",31, 0)
  20040    Q
  20041   "RTN","RCD PEWL7",32, 0)
  20042    ;
  20043   "RTN","RCD PEWL7",33, 0)
  20044   EXTRACT(RC SRT1,RCSRT 2,RCT) ; E xtract the  data
  20045   "RTN","RCD PEWL7",34, 0)
  20046    ; RCSRT1  = data val ue at 1st  sort level
  20047   "RTN","RCD PEWL7",35, 0)
  20048    ; RCSRT2  = data val ue at 2nd  sort level
  20049   "RTN","RCD PEWL7",36, 0)
  20050    ; RCT = r unning ent ry counter  - returne d if passe d by ref
  20051   "RTN","RCD PEWL7",37, 0)
  20052    N AUTOCOM P,FIRST,MD T,RC0,RCAR C,RCEFT,RC EXCEP,RCPO ST,RCSTAT, RCZ,X,XX,Z ,Z0 ;PRCA* 4.5*318 Va riable XX  added
  20053   "RTN","RCD PEWL7",38, 0)
  20054    S RCZ=0 F   S RCZ=$O (^TMP($J," RCERA_LIST ",RCSRT1,R CSRT2,RCZ) ) Q:'RCZ   D
  20055   "RTN","RCD PEWL7",39, 0)
  20056    . S RCT=R CT+1,RC0=$ G(^RCY(344 .4,RCZ,0))
  20057   "RTN","RCD PEWL7",40, 0)
  20058    . S RCEFT =+$O(^RCY( 344.31,"AE RA",RCZ,0) )
  20059   "RTN","RCD PEWL7",41, 0)
  20060    . S MDT=$ $MATCHDT^R CDPEWL7(RC EFT,"2D")  ; PRCA*4.5 *326 - Add  date matc hed
  20061   "RTN","RCD PEWL7",42, 0)
  20062    . S RCEXC EP=$$XCEPT ^RCDPEWLP( RCZ)  ; pr ca*4.5*298   assignme nt of ERA  exception  flag
  20063   "RTN","RCD PEWL7",43, 0)
  20064    . S AUTOC OMP=$$STA( RCZ) ;PRCA *4.5*326
  20065   "RTN","RCD PEWL7",44, 0)
  20066    . S RCARC =$$WLF^RCD PEWLZ(RCZ)
  20067   "RTN","RCD PEWL7",45, 0)
  20068    . S RCSTA T=$S('RCEF T:U_$S($P( RC0,U,15)= "CHK":"(CH ECK PAYMEN T EXPECTED )",$P(RC0, U,15)="NON ":"(NO PAY MENT EXPEC TED)",$P(R C0,U,9)=2: "(CHECK PA YMENT CHOS EN)",1:"N/ A"),1:$$FM SSTAT^RCDP UREC(+$P($ G(^RCY(344 .31,RCEFT, 0)),U,9)))
  20069   "RTN","RCD PEWL7",46, 0)
  20070    . S RCPOS T=$S(RCEFT :"EFT RECE IPT STATUS : ",1:"")_ $P(RCSTAT, U,2)
  20071   "RTN","RCD PEWL7",47, 0)
  20072    . ;prca*4 .5*298 inc lude Auto- Post Compl ete indica tor and ER A exceptio n flag in  $SELECT st atement
  20073   "RTN","RCD PEWL7",48, 0)
  20074    . S X=$E( RCT_$J("", 5),1,5)_"   "_$S(RCEX CEP]"":RCE XCEP,AUTOC OMP]"":AUT OCOMP,RCAR C]"":RCARC ,$D(^RCY(3 44.49,RCZ) ):" ",1:"- ")_$E($P(R C0,U)_$J(" ",10),1,10 )_"  "_$E( $P(RC0,U,2 )_$J("",50 ),1,50)
  20075   "RTN","RCD PEWL7",49, 0)
  20076    . D SET(X ,RCT,RCZ)
  20077   "RTN","RCD PEWL7",50, 0)
  20078    . S X=$J( "",43)_$J( $$FMTE^XLF DT($P(RC0, U,7),"2D") ,8)_$J("", 2)_$J(+$P( RC0,U,5),1 2,2)
  20079   "RTN","RCD PEWL7",51, 0)
  20080    . S $E(X, 73,80)=$$F MTE^XLFDT( $P(RC0,U,7 ),"2D")
  20081   "RTN","RCD PEWL7",52, 0)
  20082    . D SET(X ,RCT,RCZ)
  20083   "RTN","RCD PEWL7",53, 0)
  20084    . ; PRCA* 4.5*326 St art change d block
  20085   "RTN","RCD PEWL7",54, 0)
  20086    . S X=$J( "",8)_$E($ P(RC0,U,6) _$J("",30) ,1,30)_"   APPROX # E EOBs: "_+$ $CTEEOB^RC DPEWLB(RCZ )
  20087   "RTN","RCD PEWL7",55, 0)
  20088    . D SET(X ,RCT,RCZ)
  20089   "RTN","RCD PEWL7",56, 0)
  20090    . S X=$P( RC0,U,9),X X=$$EXTERN AL^DILFD(3 44.4,.09," ",$P(RC0,U ,9))
  20091   "RTN","RCD PEWL7",57, 0)
  20092    . S XX=$S (X=1:"EFT  MATCHED",X =2:"CHK MA TCHED",X=3 :"MATCH-0  PAY",XX=-1 :"MATCH W/ ERR",1:$P( XX," ",1))
  20093   "RTN","RCD PEWL7",58, 0)
  20094    . I X=2 S  MDT=$$GET 1^DIQ(344. 4,RCZ_",", 5.03,"I")  I MDT'=""  S MDT=$$FM TE^XLFDT(M DT,"2D")
  20095   "RTN","RCD PEWL7",59, 0)
  20096    . S:$$UNB AL^RCDPEAP 1(RCZ) XX= XX_" - UNB ALANCED"
  20097   "RTN","RCD PEWL7",60, 0)
  20098    . S X=$J( "",8)_$E(X X_$J("",25 ),1,25)_"  "_$E(MDT_$ J("",8),1, 8)
  20099   "RTN","RCD PEWL7",61, 0)
  20100    . S X=X_"   "_RCPOST
  20101   "RTN","RCD PEWL7",62, 0)
  20102    . ; PRCA* 4.5*326 En d changed  block
  20103   "RTN","RCD PEWL7",63, 0)
  20104    . D SET(X ,RCT)
  20105   "RTN","RCD PEWL7",64, 0)
  20106    . D SET("  ",RCT)
  20107   "RTN","RCD PEWL7",65, 0)
  20108    ;.; prca* 4.5*298  p er patch r equirement s, keep co de related  to
  20109   "RTN","RCD PEWL7",66, 0)
  20110    ;. ; crea ting/maint aining bat ches but j ust remove  from exec ution.
  20111   "RTN","RCD PEWL7",67, 0)
  20112    ;. ;I $G( ^TMP("RCER A_PARAMS", $J,"BATCHO N")) D
  20113   "RTN","RCD PEWL7",68, 0)
  20114    ;.. ;S Z= 0 F  S Z=$ O(^RCY(344 .49,RCZ,3, Z)) Q:'Z   S Z0=$G(^( Z,0)) I Z0 '="" D
  20115   "RTN","RCD PEWL7",69, 0)
  20116    ;...; S X =$J("",12) _$E("- BAT CH #"_$P(Z 0,U)_$J("" ,4),1,13)_ " "_$E($P( Z0,U,2)_$J ("",30),1, 30)_"  "_$ S('$P(Z0,U ,3):"NOT " ,1:"")_"RE ADY TO POS T"
  20117   "RTN","RCD PEWL7",70, 0)
  20118    ;... ;D S ET(X,RCT)
  20119   "RTN","RCD PEWL7",71, 0)
  20120    ;
  20121   "RTN","RCD PEWL7",72, 0)
  20122    S VALMSG= "Enter ??  for more a ctions and  help" ; P RCA*4.5*32 6
  20123   "RTN","RCD PEWL7",73, 0)
  20124    ;
  20125   "RTN","RCD PEWL7",74, 0)
  20126    Q
  20127   "RTN","RCD PEWL7",75, 0)
  20128    ;
  20129   "RTN","RCD PEWL7",76, 0)
  20130    ; BEGIN P RCA*4.5*32 6
  20131   "RTN","RCD PEWL7",77, 0)
  20132   STA(RCZ) ; Determine  auto-post  status and  if marked  for auto- post
  20133   "RTN","RCD PEWL7",78, 0)
  20134    ; Input -  RCZ = ERA  ien
  20135   "RTN","RCD PEWL7",79, 0)
  20136    ; Output  - "" = UNP OSTED
  20137   "RTN","RCD PEWL7",80, 0)
  20138    ;           "A" = CO MPLETE
  20139   "RTN","RCD PEWL7",81, 0)
  20140    ;           "P" = PA RTIAL
  20141   "RTN","RCD PEWL7",82, 0)
  20142    ;           "M" = MA RKED
  20143   "RTN","RCD PEWL7",83, 0)
  20144    N STA
  20145   "RTN","RCD PEWL7",84, 0)
  20146    ;Get ERA  auto-post  status
  20147   "RTN","RCD PEWL7",85, 0)
  20148    S STA=$$G ET1^DIQ(34 4.4,RCZ_", ",4.02,"I" )
  20149   "RTN","RCD PEWL7",86, 0)
  20150    ;Not auto -post ERA
  20151   "RTN","RCD PEWL7",87, 0)
  20152    Q:STA=""  ""
  20153   "RTN","RCD PEWL7",88, 0)
  20154    ;Unposted  but marke d for auto post
  20155   "RTN","RCD PEWL7",89, 0)
  20156    I STA=0,$ $GET1^DIQ( 344.4,RCZ_ ",",4.04," I")]"" Q " M"
  20157   "RTN","RCD PEWL7",90, 0)
  20158    ;Unposted  - EFT sti ll not acc epted
  20159   "RTN","RCD PEWL7",91, 0)
  20160    Q:STA=0 " "
  20161   "RTN","RCD PEWL7",92, 0)
  20162    ;Complete
  20163   "RTN","RCD PEWL7",93, 0)
  20164    Q:STA=2 " A"
  20165   "RTN","RCD PEWL7",94, 0)
  20166    ;Partial
  20167   "RTN","RCD PEWL7",95, 0)
  20168    N MATCH,S UB
  20169   "RTN","RCD PEWL7",96, 0)
  20170    S MATCH=0 ,SUB=0
  20171   "RTN","RCD PEWL7",97, 0)
  20172    F  S SUB= $O(^RCY(34 4.4,RCZ,1, SUB)) Q:'S UB  D  Q:M ATCH
  20173   "RTN","RCD PEWL7",98, 0)
  20174    .S MATCH= $$GET1^DIQ (344.41,SU B_","_RCZ, 6,"I")
  20175   "RTN","RCD PEWL7",99, 0)
  20176    Q $S(MATC H:"M",1:"P ")
  20177   "RTN","RCD PEWL7",100 ,0)
  20178    ; END PRC A*4.5*326
  20179   "RTN","RCD PEWL7",101 ,0)
  20180    ;
  20181   "RTN","RCD PEWL7",102 ,0)
  20182   MATCHDT(RC EFT,FORMAT ) ;EP
  20183   "RTN","RCD PEWL7",103 ,0)
  20184    ; Get the  Date the  ERA was ma tched
  20185   "RTN","RCD PEWL7",104 ,0)
  20186    ; Input:  RCEFT    -  IEN for f ile 344.31
  20187   "RTN","RCD PEWL7",105 ,0)
  20188    ;         FORMAT   -  (Optional ) date for mat for se cond param eter of FM TE^XLFDT ( Defaults t o 2DZ)
  20189   "RTN","RCD PEWL7",106 ,0)
  20190    ; Returns : External  date when  the ERA w as matched  or ""
  20191   "RTN","RCD PEWL7",107 ,0)
  20192    I '$G(RCE FT) Q ""
  20193   "RTN","RCD PEWL7",108 ,0)
  20194    N IENS,XX
  20195   "RTN","RCD PEWL7",109 ,0)
  20196    I $G(FORM AT)="" S F ORMAT="2DZ "
  20197   "RTN","RCD PEWL7",110 ,0)
  20198    S XX=$O(^ RCY(344.31 ,RCEFT,4," A"),-1)    ; Get last  Match Sta tus Histor y record
  20199   "RTN","RCD PEWL7",111 ,0)
  20200    Q:XX="" " "
  20201   "RTN","RCD PEWL7",112 ,0)
  20202    S IENS=XX _","_RCEFT _","
  20203   "RTN","RCD PEWL7",113 ,0)
  20204    S XX=$$GE T1^DIQ(344 .314,IENS, .02,"I")
  20205   "RTN","RCD PEWL7",114 ,0)
  20206    Q:XX="" " "
  20207   "RTN","RCD PEWL7",115 ,0)
  20208    S XX=$$FM TE^XLFDT(X X,FORMAT)
  20209   "RTN","RCD PEWL7",116 ,0)
  20210    Q XX
  20211   "RTN","RCD PEWL7",117 ,0)
  20212    ;
  20213   "RTN","RCD PEWL7",118 ,0)
  20214   SL(Y,SORT)  ; Returns  data for  sort level  from entr y Y in fil e 344.4
  20215   "RTN","RCD PEWL7",119 ,0)
  20216    ; SORT =  the sort d ata in ';'  delimited  pieces
  20217   "RTN","RCD PEWL7",120 ,0)
  20218    ;    pc 1  = code fo r sort dat a
  20219   "RTN","RCD PEWL7",121 ,0)
  20220    ;    pc 2  = the ord er request ed (- or n ull)
  20221   "RTN","RCD PEWL7",122 ,0)
  20222    ;
  20223   "RTN","RCD PEWL7",123 ,0)
  20224    N RC0,DAT ,SORT1,SOR T2
  20225   "RTN","RCD PEWL7",124 ,0)
  20226    S SORT1=$ P(SORT,";" ),SORT2=$P (SORT,";", 2)
  20227   "RTN","RCD PEWL7",125 ,0)
  20228    S RC0=$G( ^RCY(344.4 ,Y,0)),DAT =" "
  20229   "RTN","RCD PEWL7",126 ,0)
  20230    ; No sort
  20231   "RTN","RCD PEWL7",127 ,0)
  20232    I SORT=""  G SLQ
  20233   "RTN","RCD PEWL7",128 ,0)
  20234    ; Amt pai d
  20235   "RTN","RCD PEWL7",129 ,0)
  20236    I SORT1=" AP" D  G S LQ
  20237   "RTN","RCD PEWL7",130 ,0)
  20238    . S DAT=S ORT2_+$P(R C0,U,5)
  20239   "RTN","RCD PEWL7",131 ,0)
  20240    ; ERA dat e pd
  20241   "RTN","RCD PEWL7",132 ,0)
  20242    I SORT1=" DP" D  G S LQ
  20243   "RTN","RCD PEWL7",133 ,0)
  20244    . S DAT=S ORT2_($P(R C0,U,4)\1)
  20245   "RTN","RCD PEWL7",134 ,0)
  20246    ; Payer n ame
  20247   "RTN","RCD PEWL7",135 ,0)
  20248    I SORT1=" PN" D  G S LQ
  20249   "RTN","RCD PEWL7",136 ,0)
  20250    . S DAT=$ $UP^RCDPEA RL($P(RC0, U,6))
  20251   "RTN","RCD PEWL7",137 ,0)
  20252    ; ERA dat e received
  20253   "RTN","RCD PEWL7",138 ,0)
  20254    I SORT1=" DR" D  G S LQ
  20255   "RTN","RCD PEWL7",139 ,0)
  20256    . S DAT=S ORT2_($P(R C0,U,7)\1)
  20257   "RTN","RCD PEWL7",140 ,0)
  20258    ;
  20259   "RTN","RCD PEWL7",141 ,0)
  20260   SLQ Q $S(D AT'="":DAT ,1:" ")
  20261   "RTN","RCD PEWL7",142 ,0)
  20262    ;
  20263   "RTN","RCD PEWL7",143 ,0)
  20264   INIT ; Ent ry point f or List te mplate to  build the  display of  ERAs
  20265   "RTN","RCD PEWL7",144 ,0)
  20266    ;
  20267   "RTN","RCD PEWL7",145 ,0)
  20268    ; Paramet ers for se lecting ER As to be i ncluded in  the list  are
  20269   "RTN","RCD PEWL7",146 ,0)
  20270    ; contain ed in the  global ^TM P("RCERA_P ARAMS",$J, parameter  name)
  20271   "RTN","RCD PEWL7",147 ,0)
  20272    ;
  20273   "RTN","RCD PEWL7",148 ,0)
  20274    N RCZ,RC0 ,RCT,RCTT, RCQUIT,RCD TFR,RCDTTO ,DTOUT,DUO UT,DIR,X,Y ,Z,Z1,RCPO ST,RCEFT,R CINDX,QFLG
  20275   "RTN","RCD PEWL7",149 ,0)
  20276    D CLEAN^V ALM10
  20277   "RTN","RCD PEWL7",150 ,0)
  20278    K ^TMP("R CDPE-ERA_W L",$J),^TM P("RCDPE-E RA_WLDX",$ J),^TMP($J ,"RCERA_LI ST")
  20279   "RTN","RCD PEWL7",151 ,0)
  20280    ;
  20281   "RTN","RCD PEWL7",152 ,0)
  20282    S (RCT,RC TT,RCQUIT) =0
  20283   "RTN","RCD PEWL7",153 ,0)
  20284    ;
  20285   "RTN","RCD PEWL7",154 ,0)
  20286    S RCDTFR= +$P($G(^TM P("RCERA_P ARAMS",$J, "RCDT")),U ),RCDTTO=$ S($P($G(^T MP("RCERA_ PARAMS",$J ,"RCDT")), U,2):$P(^( "RCDT"),U, 2),1:DT)
  20287   "RTN","RCD PEWL7",155 ,0)
  20288    ;
  20289   "RTN","RCD PEWL7",156 ,0)
  20290    S RCINDX= $S(RCDTFR: RCDTFR-.00 000001,1:0 )
  20291   "RTN","RCD PEWL7",157 ,0)
  20292    W !!,"SEA RCHING, PL EASE STAND BY (PRESS  '^' TO QUI T SEARCH)" ,!!
  20293   "RTN","RCD PEWL7",158 ,0)
  20294    F  S RCIN DX=$O(^RCY (344.4,"AF D",RCINDX) ) Q:'RCIND X!(RCINDX\ 1>RCDTTO)! RCQUIT  S  RCZ=0 F  S  RCZ=$O(^R CY(344.4," AFD",RCIND X,RCZ)) Q: 'RCZ  D  Q :RCQUIT
  20295   "RTN","RCD PEWL7",159 ,0)
  20296    . S RCTT= RCTT+1
  20297   "RTN","RCD PEWL7",160 ,0)
  20298    . I RCTT> 19999 D  Q :RCQUIT=1
  20299   "RTN","RCD PEWL7",161 ,0)
  20300    . . S RCT T=0
  20301   "RTN","RCD PEWL7",162 ,0)
  20302    . . D WAI T^DICD
  20303   "RTN","RCD PEWL7",163 ,0)
  20304    . . D INI TKB^XGF ;  supported  by DBIA 31 73
  20305   "RTN","RCD PEWL7",164 ,0)
  20306    . . S QFL G=$$READ^X GF(1,1)
  20307   "RTN","RCD PEWL7",165 ,0)
  20308    . . Q:$G( DTOUT)
  20309   "RTN","RCD PEWL7",166 ,0)
  20310    . . S:QFL G="^" RCQU IT=1 Q
  20311   "RTN","RCD PEWL7",167 ,0)
  20312    . . I $D( DUOUT)!(Y= 0) S RCQUI T=1 Q
  20313   "RTN","RCD PEWL7",168 ,0)
  20314    . . D RES ETKB^XGF
  20315   "RTN","RCD PEWL7",169 ,0)
  20316    . ;
  20317   "RTN","RCD PEWL7",170 ,0)
  20318    . S RC0=$ G(^RCY(344 .4,RCZ,0))
  20319   "RTN","RCD PEWL7",171 ,0)
  20320    . I $$FIL TER(RCZ) S  ^TMP($J," RCERA_LIST ",$$SL(RCZ ,"DR"),$$S L(RCZ,""), RCZ)=""
  20321   "RTN","RCD PEWL7",172 ,0)
  20322    ;
  20323   "RTN","RCD PEWL7",173 ,0)
  20324    ; Output  the list
  20325   "RTN","RCD PEWL7",174 ,0)
  20326    I 'RCQUIT  D
  20327   "RTN","RCD PEWL7",175 ,0)
  20328    . D:$D(^T MP($J,"RCE RA_LIST"))  BLD("DR^N ")
  20329   "RTN","RCD PEWL7",176 ,0)
  20330    . ; If no  ERAs foun d display  the messag e below in  the list  area
  20331   "RTN","RCD PEWL7",177 ,0)
  20332    . I '$O(^ TMP("RCDPE -ERA_WL",$ J,0)) D
  20333   "RTN","RCD PEWL7",178 ,0)
  20334    . . S ^TM P("RCDPE-E RA_WL",$J, 1,0)="THER E ARE NO E RAs MATCHI NG YOUR SE LECTION CR ITERIA" S  VALMCNT=2
  20335   "RTN","RCD PEWL7",179 ,0)
  20336    I RCQUIT  K ^TMP("RC DPE-ERA_WL ",$J),^TMP ("RCDPE-ER A_WLDX",$J ),^TMP($J, "RCERA_LIS T") S VALM QUIT=""
  20337   "RTN","RCD PEWL7",180 ,0)
  20338    Q
  20339   "RTN","RCD PEWL7",181 ,0)
  20340    ;
  20341   "RTN","RCD PEWL7",182 ,0)
  20342   HDR ; Head er for ERA  Worklist  (List user  Current S creen View  selection s)
  20343   "RTN","RCD PEWL7",183 ,0)
  20344    ; Input:  ^TMP("RCER A_PARAMS", $J)
  20345   "RTN","RCD PEWL7",184 ,0)
  20346    ; Output:  VALMHDR
  20347   "RTN","RCD PEWL7",185 ,0)
  20348    N X,XX,XX 2
  20349   "RTN","RCD PEWL7",186 ,0)
  20350    ;
  20351   "RTN","RCD PEWL7",187 ,0)
  20352    ; PRCA*4. 5*321 - To tal re-wri te of head er subrout ine to add  new filte rs and sho rten lines  etc.
  20353   "RTN","RCD PEWL7",188 ,0)
  20354    ; First h eader line . Date ran ge and Pha rmacy/Tric are/Medica l
  20355   "RTN","RCD PEWL7",189 ,0)
  20356    S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCDT"))
  20357   "RTN","RCD PEWL7",190 ,0)
  20358    S XX="DAT E RANGE  :  "
  20359   "RTN","RCD PEWL7",191 ,0)
  20360    I $P(X,U)  D  ;
  20361   "RTN","RCD PEWL7",192 ,0)
  20362    . S XX=XX _$$FMTE^XL FDT($P(X,U ),2)
  20363   "RTN","RCD PEWL7",193 ,0)
  20364    . I $P(X, U,2) S XX= XX_"-"_$$F MTE^XLFDT( $P(X,U,2), 2)
  20365   "RTN","RCD PEWL7",194 ,0)
  20366    E  S XX=X X_"NONE SE LECTED"
  20367   "RTN","RCD PEWL7",195 ,0)
  20368    S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCTYPE") )
  20369   "RTN","RCD PEWL7",196 ,0)
  20370    S XX2="ME DICAL/PHAR M/TRIC: "  ; PRCA*4.5 *332
  20371   "RTN","RCD PEWL7",197 ,0)
  20372    S XX2=XX2 _$S(X="M": "MEDICAL O NLY",X="P" :"PHARMACY  ONLY",X=" T":"TRICAR E ONLY",1: "ALL")
  20373   "RTN","RCD PEWL7",198 ,0)
  20374    S XX=$$SE TSTR^VALM1 (XX2,XX,40 ,41)
  20375   "RTN","RCD PEWL7",199 ,0)
  20376    S VALMHDR (1)=XX
  20377   "RTN","RCD PEWL7",200 ,0)
  20378    ;
  20379   "RTN","RCD PEWL7",201 ,0)
  20380    ; Second  header lin e. Match/U nmatched a nd Auto-po sting/Non  Autopostin g
  20381   "RTN","RCD PEWL7",202 ,0)
  20382    S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCMATCH" ))
  20383   "RTN","RCD PEWL7",203 ,0)
  20384    S XX="MAT CH STATUS:  "_$S(X="N ":"NOT MAT CHED",X="M ":"MATCHED ",1:"BOTH" )
  20385   "RTN","RCD PEWL7",204 ,0)
  20386    S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCAUTOP" ))
  20387   "RTN","RCD PEWL7",205 ,0)
  20388    S XX2="AU TO-POSTING : "
  20389   "RTN","RCD PEWL7",206 ,0)
  20390    S XX2=XX2 _$S(X="A": "AUTO-POST ING ONLY", X="N":"NON  AUTO-POST ING ONLY", 1:"BOTH")
  20391   "RTN","RCD PEWL7",207 ,0)
  20392    S XX=$$SE TSTR^VALM1 (XX2,XX,46 ,35)
  20393   "RTN","RCD PEWL7",208 ,0)
  20394    ; BEGIN P RCA*4.5*32 6
  20395   "RTN","RCD PEWL7",209 ,0)
  20396    I X'="N"  D
  20397   "RTN","RCD PEWL7",210 ,0)
  20398    .S X=$G(^ TMP("RCERA _PARAMS",$ J,"RCAPSTA "))
  20399   "RTN","RCD PEWL7",211 ,0)
  20400    .S XX2="A UTOP: "_$S (X="P":"PA RTIAL",X=" C":"COMPLE TE",X="M": "MARKED",1 :"ALL")
  20401   "RTN","RCD PEWL7",212 ,0)
  20402    .S XX=$$S ETSTR^VALM 1(XX2,XX,2 7,15)
  20403   "RTN","RCD PEWL7",213 ,0)
  20404    ; END PRC A*4.5*326
  20405   "RTN","RCD PEWL7",214 ,0)
  20406    S VALMHDR (2)=XX
  20407   "RTN","RCD PEWL7",215 ,0)
  20408    ;
  20409   "RTN","RCD PEWL7",216 ,0)
  20410    ; Third h eader line . Post sta tus, payer  name rang e and zero  payment/p ayment
  20411   "RTN","RCD PEWL7",217 ,0)
  20412    S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCPOST") )
  20413   "RTN","RCD PEWL7",218 ,0)
  20414    S XX="POS T STATUS :  "_$S(X="U ":"UNPOSTE D",X="P":" POSTED",1: "BOTH")
  20415   "RTN","RCD PEWL7",219 ,0)
  20416    S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCPAYR") )
  20417   "RTN","RCD PEWL7",220 ,0)
  20418    I $P(X,U) ="A"!(X="" ) D  ;
  20419   "RTN","RCD PEWL7",221 ,0)
  20420    . S XX2=" ALL PAYERS "
  20421   "RTN","RCD PEWL7",222 ,0)
  20422    E  D  ;
  20423   "RTN","RCD PEWL7",223 ,0)
  20424    . S XX2=$ P(X,U,2)_" -"_$P(X,U, 3)
  20425   "RTN","RCD PEWL7",224 ,0)
  20426    . I $L(XX 2)>11 S XX 2="RANGE"
  20427   "RTN","RCD PEWL7",225 ,0)
  20428    S XX2="PA YERS: "_XX 2
  20429   "RTN","RCD PEWL7",226 ,0)
  20430    S XX=$$SE TSTR^VALM1 (XX2,XX,26 ,20)
  20431   "RTN","RCD PEWL7",227 ,0)
  20432    S X=$G(^T MP("RCERA_ PARAMS",$J ,"RCPAYMNT "))
  20433   "RTN","RCD PEWL7",228 ,0)
  20434    S XX2="PA YMENT TYPE : "
  20435   "RTN","RCD PEWL7",229 ,0)
  20436    S XX2=XX2 _$S(X="Z": "ZERO PAYM ENTS ONLY" ,X="P":"PA YMENTS ONL Y",1:"BOTH ")
  20437   "RTN","RCD PEWL7",230 ,0)
  20438    S XX=$$SE TSTR^VALM1 (XX2,XX,46 ,35)
  20439   "RTN","RCD PEWL7",231 ,0)
  20440    S VALMHDR (3)=XX
  20441   "RTN","RCD PEWL7",232 ,0)
  20442    ;
  20443   "RTN","RCD PEWL7",233 ,0)
  20444    S VALMHDR (4)="#        ERA #              Trace#"
  20445   "RTN","RCD PEWL7",234 ,0)
  20446    Q
  20447   "RTN","RCD PEWL7",235 ,0)
  20448    ;
  20449   "RTN","RCD PEWL7",236 ,0)
  20450   FNL ; -- C lean up li st
  20451   "RTN","RCD PEWL7",237 ,0)
  20452    K ^TMP("R CDPE-ERA_W L",$J),^TM P("RCDPE-E RA_WLDX",$ J),^TMP("R CERA_PARAM S",$J),^TM P($J,"RCER A_LIST")
  20453   "RTN","RCD PEWL7",238 ,0)
  20454    Q
  20455   "RTN","RCD PEWL7",239 ,0)
  20456    ;
  20457   "RTN","RCD PEWL7",240 ,0)
  20458   SET(X,RCSE Q,RCSEQ1)  ; -- set a rrays
  20459   "RTN","RCD PEWL7",241 ,0)
  20460    ; X = the  data to s et into th e global
  20461   "RTN","RCD PEWL7",242 ,0)
  20462    ; RCSEQ =  the selec table line  #
  20463   "RTN","RCD PEWL7",243 ,0)
  20464    ; RCSEQ1  = the ien  of the ent ry in file  344.4
  20465   "RTN","RCD PEWL7",244 ,0)
  20466    S VALMCNT =VALMCNT+1 ,^TMP("RCD PE-ERA_WL" ,$J,VALMCN T,0)=X
  20467   "RTN","RCD PEWL7",245 ,0)
  20468    I $G(RCSE Q) S ^TMP( "RCDPE-ERA _WL",$J,"I DX",VALMCN T,RCSEQ)=$ G(RCSEQ1)
  20469   "RTN","RCD PEWL7",246 ,0)
  20470    I $G(RCSE Q1) S ^TMP ("RCDPE-ER A_WLDX",$J ,RCSEQ)=VA LMCNT_U_RC SEQ1
  20471   "RTN","RCD PEWL7",247 ,0)
  20472    Q
  20473   "RTN","RCD PEWL7",248 ,0)
  20474    ;
  20475   "RTN","RCD PEWL7",249 ,0)
  20476   ENTERWL ;  Enter the  worklist w ith an ERA
  20477   "RTN","RCD PEWL7",250 ,0)
  20478    D WL($$SE L())
  20479   "RTN","RCD PEWL7",251 ,0)
  20480    D BLD($G( ^TMP("RCER A_PARAMS", $J,"SORT") ))
  20481   "RTN","RCD PEWL7",252 ,0)
  20482    S VALMBCK ="R"
  20483   "RTN","RCD PEWL7",253 ,0)
  20484    Q
  20485   "RTN","RCD PEWL7",254 ,0)
  20486    ;
  20487   "RTN","RCD PEWL7",255 ,0)
  20488   SEL() ; Se lect an ER A from the  ERA list
  20489   "RTN","RCD PEWL7",256 ,0)
  20490    N RCDA,VA LMY
  20491   "RTN","RCD PEWL7",257 ,0)
  20492    D FULL^VA LM1
  20493   "RTN","RCD PEWL7",258 ,0)
  20494    D EN^VALM 2($G(XQORN OD(0)),"S" )
  20495   "RTN","RCD PEWL7",259 ,0)
  20496    S RCERA=0
  20497   "RTN","RCD PEWL7",260 ,0)
  20498    S RCDA=0  F  S RCDA= $O(VALMY(R CDA)) Q:'R CDA  S RCE RA=+$P($G( ^TMP("RCDP E-ERA_WLDX ",$J,RCDA) ),U,2)
  20499   "RTN","RCD PEWL7",261 ,0)
  20500    ;
  20501   "RTN","RCD PEWL7",262 ,0)
  20502    Q RCERA
  20503   "RTN","RCD PEWL7",263 ,0)
  20504    ;
  20505   "RTN","RCD PEWL7",264 ,0)
  20506   WL(RCERA)  ; Enter wo rklist
  20507   "RTN","RCD PEWL7",265 ,0)
  20508    ;
  20509   "RTN","RCD PEWL7",266 ,0)
  20510    ;              input  - RCERA =  ien of th e ERA entr y in file  344.4
  20511   "RTN","RCD PEWL7",267 ,0)
  20512    ;
  20513   "RTN","RCD PEWL7",268 ,0)
  20514    N DA,DIE, DIR,DR,DTO UT,DUOUT,I ,PREVENT,R C0,RCNOED, RCQUIT,RCS ORT,RCEXC, RETCODES,S TATE,TYPE, X,Y
  20515   "RTN","RCD PEWL7",269 ,0)
  20516    Q:RCERA'> 0
  20517   "RTN","RCD PEWL7",270 ,0)
  20518    ; PRCA*4. 5*304 - Re entry if w e cleared  exceptions
  20519   "RTN","RCD PEWL7",271 ,0)
  20520   WL1 ; rete st to make  sure this  ERA does  not have a n exceptio n
  20521   "RTN","RCD PEWL7",272 ,0)
  20522    S TYPE=$S ($$PAYTYPE (RCERA,"P" ):"P",1:"M "),RCEXC=0  ; PRCA*4. 5*321
  20523   "RTN","RCD PEWL7",273 ,0)
  20524    ; PRCA*4. 5*304 - se e if we ha ve the ERA  and go to  WL1 to re test.
  20525   "RTN","RCD PEWL7",274 ,0)
  20526    I ($$XCEP T^RCDPEWLP (RCERA)]"" )&(TYPE="M ") D EXCDE NY^RCDPEWL P Q  ;cann ot process  MEDICAL E RA if exce ption exis ts then fa ll back to  Worklist.
  20527   "RTN","RCD PEWL7",275 ,0)
  20528    ; PRCA*4. 5*304 - Re moved the  G:($G(RCER A)'="")&&( $G(RCEXC)= 1) WL1 fro m above so  it falls  back to th e worklist  instead o f going fo rward to t he "Select  ERA"
  20529   "RTN","RCD PEWL7",276 ,0)
  20530    ; I ($$XC EPT^RCDPEW LP(RCERA)] "")&(TYPE= "M") D EXC DENY^RCDPE WLP G:($G( RCERA)'="" )&&($G(RCE XC)=1) WL1  Q
  20531   "RTN","RCD PEWL7",277 ,0)
  20532    S (RCQUIT ,RCNOED,PR EVENT)=0,R C0=$G(^RCY (344.4,RCE RA,0)),RCS ORT=""
  20533   "RTN","RCD PEWL7",278 ,0)
  20534    I $P(RC0, U,8) D
  20535   "RTN","RCD PEWL7",279 ,0)
  20536    . I '$D(^ RCY(344.49 ,RCERA,0))  D  Q
  20537   "RTN","RCD PEWL7",280 ,0)
  20538    .. S RCQU IT=1
  20539   "RTN","RCD PEWL7",281 ,0)
  20540    .. W ! S  DIR(0)="EA ",DIR("A", 1)="A SCRA TCH PAD WA S NOT CREA TED FOR TH IS ERA BEF ORE POSTIN G",DIR("A" ,2)="USE T HE VIEW/PR INT ERA OP TION TO SE E ITS DETA IL",DIR("A ")="Press  ENTER to c ontinue: "  D ^DIR K  DIR Q
  20541   "RTN","RCD PEWL7",282 ,0)
  20542    . ;
  20543   "RTN","RCD PEWL7",283 ,0)
  20544    . S RCNOE D=+$P(RC0, U,8)
  20545   "RTN","RCD PEWL7",284 ,0)
  20546    . S DIR(0 )="EA",DIR ("A",1)="T HIS ERA AL READY HAS  A RECEIPT  - YOU MAY  ONLY VIEW  ITS SCRATC H PAD",DIR ("A")="Pre ss ENTER t o continue : "
  20547   "RTN","RCD PEWL7",285 ,0)
  20548    . W ! D ^ DIR K DIR  W !
  20549   "RTN","RCD PEWL7",286 ,0)
  20550    G:RCQUIT  WLQ
  20551   "RTN","RCD PEWL7",287 ,0)
  20552    G:RCNOED  WLD   ; al ready has  a receipt  so no need  to check  for older  unposted E FTs
  20553   "RTN","RCD PEWL7",288 ,0)
  20554    ; functio n $$AGEDEF TS - searc h for any  UNPOSTED E FTs older  than 14 da ys (medica l) or 30 d ays (pharm acy)
  20555   "RTN","RCD PEWL7",289 ,0)
  20556    ; return  value of 0 , 2, or 3  represent  that entry  into scra tchpad can  occur
  20557   "RTN","RCD PEWL7",290 ,0)
  20558    S TYPE=$S (TYPE="P": "P",$$PAYT YPE(RCERA, "T"):"T",1 :"M") ; PR CA*4.5*332
  20559   "RTN","RCD PEWL7",291 ,0)
  20560    S RETCODE S=$$AGEDEF TS^RCDPEWL P(RCERA,TY PE) ; PRCA *4.5*332
  20561   "RTN","RCD PEWL7",292 ,0)
  20562    S PREVENT =0
  20563   "RTN","RCD PEWL7",293 ,0)
  20564    F I=1:1 S  STATE=$P( RETCODES,U ,I) Q:STAT E=""  I $E (STATE,2)= TYPE,$E(ST ATE,1)=1 S  PREVENT=1  ; PRCA*4. 5*332
  20565   "RTN","RCD PEWL7",294 ,0)
  20566    Q:PREVENT    ; preve nt user fr om enterin g scratchp ad; there  are older  EFTs on th e system t hat need t o be worke d.
  20567   "RTN","RCD PEWL7",295 ,0)
  20568   WLD ;
  20569   "RTN","RCD PEWL7",296 ,0)
  20570    D DISP^RC DPEWL(RCER A,RCNOED)
  20571   "RTN","RCD PEWL7",297 ,0)
  20572    ;
  20573   "RTN","RCD PEWL7",298 ,0)
  20574    ; prca*4. 5*298  per  patch req uirements,  keep code  related t
  20575   "RTN","RCD PEWL7",299 ,0)
  20576    ; creatin g/maintain ing batche s but just  remove fr om executi on.
  20577   "RTN","RCD PEWL7",300 ,0)
  20578    ;I 'RCQUI T,$G(^TMP( "RCBATCH_S ELECTED",$ J)) D
  20579   "RTN","RCD PEWL7",301 ,0)
  20580    ;. S DA(1 )=RCERA,DA =+$G(^TMP( "RCBATCH_S ELECTED",$ J)),DR=".0 5////0",DI E="^RCY(34 4.49,"_DA( 1)_",3," D  ^DIE
  20581   "RTN","RCD PEWL7",302 ,0)
  20582    ;. L -^RC Y(344.49,D A(1),3,DA, 0)
  20583   "RTN","RCD PEWL7",303 ,0)
  20584    ;. K ^TMP ("RCBATCH_ SELECTED", $J)
  20585   "RTN","RCD PEWL7",304 ,0)
  20586    ;E  D
  20587   "RTN","RCD PEWL7",305 ,0)
  20588    ;L -^RCY( 344.4,RCER A,0)
  20589   "RTN","RCD PEWL7",306 ,0)
  20590   WLQ ;
  20591   "RTN","RCD PEWL7",307 ,0)
  20592    L -^RCY(3 44.4,RCERA ,0)
  20593   "RTN","RCD PEWL7",308 ,0)
  20594    Q
  20595   "RTN","RCD PEWL7",309 ,0)
  20596    ;
  20597   "RTN","RCD PEWL7",310 ,0)
  20598   PRERA ; Vi ew/Print E RA from ER A list men u
  20599   "RTN","RCD PEWL7",311 ,0)
  20600    N RCSCR
  20601   "RTN","RCD PEWL7",312 ,0)
  20602    S RCSCR=$ $SEL()
  20603   "RTN","RCD PEWL7",313 ,0)
  20604    I RCSCR>0  D PRERA^R CDPEWL0
  20605   "RTN","RCD PEWL7",314 ,0)
  20606    S VALMBCK ="R"
  20607   "RTN","RCD PEWL7",315 ,0)
  20608    Q
  20609   "RTN","RCD PEWL7",316 ,0)
  20610    ;
  20611   "RTN","RCD PEWL7",317 ,0)
  20612   BAT(RCERA)  ; Select  batch, if  needed
  20613   "RTN","RCD PEWL7",318 ,0)
  20614    ; Returns  1 if batc h selected  OK or no  batch need ed
  20615   "RTN","RCD PEWL7",319 ,0)
  20616    ; RCERA =  ien of en try in fil e 344.49
  20617   "RTN","RCD PEWL7",320 ,0)
  20618    N RCINUSE ,RCQUIT,RC ADJ,RC0,RC OK,DIR,DTO UT,DUOUT,X ,Y,Z
  20619   "RTN","RCD PEWL7",321 ,0)
  20620    K ^TMP("R CBATCH_SEL ECTED",$J)
  20621   "RTN","RCD PEWL7",322 ,0)
  20622    S RCOK=1
  20623   "RTN","RCD PEWL7",323 ,0)
  20624    I '$O(^RC Y(344.49,R CERA,3,0))  G BATQ
  20625   "RTN","RCD PEWL7",324 ,0)
  20626    S RC0=$G( ^RCY(344.4 ,RCERA,0))
  20627   "RTN","RCD PEWL7",325 ,0)
  20628    S (RCQUIT ,RCADJ)=0
  20629   "RTN","RCD PEWL7",326 ,0)
  20630    I $$HASAD J^RCDPEWL8 (RCERA) D
  20631   "RTN","RCD PEWL7",327 ,0)
  20632    . S RCADJ =1
  20633   "RTN","RCD PEWL7",328 ,0)
  20634    . S DIR(" A",1)="THI S ERA HAS  NEGATIVE A DJUSTMENTS  THAT NEED  TO BE DIS TRIBUTED T O OTHER",D IR("A",2)= "PAYMENTS  ON THE ERA .  YOU CAN NOT SELECT  ANY INDIV IDUAL BATC HES UNTIL" ,DIR("A",3 )="THE DIS TRIBUTIONS  ARE COMPL ETE."
  20635   "RTN","RCD PEWL7",329 ,0)
  20636    . S DIR(" A")="Press  ENTER to  continue:  ",DIR(0)=" EA" W ! D  ^DIR K DIR
  20637   "RTN","RCD PEWL7",330 ,0)
  20638    S RCINUSE =+$O(^RCY( 344.49,"AI NUSE",1,RC ERA,0))
  20639   "RTN","RCD PEWL7",331 ,0)
  20640    I RCINUSE  D
  20641   "RTN","RCD PEWL7",332 ,0)
  20642    . N OK,Z
  20643   "RTN","RCD PEWL7",333 ,0)
  20644    . Q:RCADJ !$P(RC0,U, 8)
  20645   "RTN","RCD PEWL7",334 ,0)
  20646    . S OK=0  S Z=0 F  S  Z=$O(^RCY (344.49,RC ERA,3,Z))  Q:'Z  I '$ P($G(^RCY( 344.49,RCE RA,3,Z,0)) ,U,5) S OK =1 Q
  20647   "RTN","RCD PEWL7",335 ,0)
  20648    . I 'OK D   Q
  20649   "RTN","RCD PEWL7",336 ,0)
  20650    .. S DIR( "A",1)="AL L BATCHES  WITHIN THI S ERA ARE  CURRENTLY  IN USE - T RY AGAIN L ATER",DIR( "A")="Pres s ENTER to  continue:  ",DIR(0)= "EA" W ! D  ^DIR K DI R S RCQUIT =1,RCOK=0  Q
  20651   "RTN","RCD PEWL7",337 ,0)
  20652    . W !!,"A T LEAST 1  BATCH WITH IN THIS ER A IS CURRE NTLY IN US E",!,"AT T HIS TIME,  YOU CAN ON LY ACCESS  INDIVIDUAL  BATCHES", !
  20653   "RTN","RCD PEWL7",338 ,0)
  20654    . D SELBA T^RCDPEWL8 (RCERA,.RC QUIT)
  20655   "RTN","RCD PEWL7",339 ,0)
  20656    . I RCQUI T S RCOK=0
  20657   "RTN","RCD PEWL7",340 ,0)
  20658    E  D
  20659   "RTN","RCD PEWL7",341 ,0)
  20660    . Q:$P(RC 0,U,8)!RCA DJ  ; Alwa ys require  the entir e ERA be u sed
  20661   "RTN","RCD PEWL7",342 ,0)
  20662    . S DIR(0 )="SA^E:(E )NTIRE ERA ;B:(B)ATCH ",DIR("A") ="DO YOU W ANT THE (E )NTIRE ERA  OR JUST A  (B)ATCH?:  " W ! D ^ DIR K DIR
  20663   "RTN","RCD PEWL7",343 ,0)
  20664    . I $D(DT OUT)!$D(DU OUT) S RCQ UIT=1,RCOK =0 Q
  20665   "RTN","RCD PEWL7",344 ,0)
  20666    . I Y="E"  D  Q
  20667   "RTN","RCD PEWL7",345 ,0)
  20668    .. S RCQU IT=1 F Z=1 :1:2 L +^R CY(344.4,R CERA,0):5  I $T S RCQ UIT=0 Q
  20669   "RTN","RCD PEWL7",346 ,0)
  20670    .. I RCQU IT S RCOK= 0,DIR(0)=" EA",DIR("A ",1)="ANOT HER USER I S CURRENTL Y USING TH IS ERA, TR Y AGAIN LA TER",DIR(" A")="Press  ENTER to  continue:  " W ! D ^D IR K DIR Q
  20671   "RTN","RCD PEWL7",347 ,0)
  20672    . D SELBA T^RCDPEWL8 (RCERA,.RC QUIT)
  20673   "RTN","RCD PEWL7",348 ,0)
  20674    . I RCQUI T S RCOK=0
  20675   "RTN","RCD PEWL7",349 ,0)
  20676    ;
  20677   "RTN","RCD PEWL7",350 ,0)
  20678   BATQ Q RCO K
  20679   "RTN","RCD PEWL7",351 ,0)
  20680    ;
  20681   "RTN","RCD PEWL7",352 ,0)
  20682   PAYTYPE(IE N,TYPE) ;  EP - New w ay to tell  if a paye r is phara mcy, Trica re or medi cal - Adde d for PRCA *4.5*321
  20683   "RTN","RCD PEWL7",353 ,0)
  20684    ; Input:  IEN - Inte rnal entry  number of  an ERA (# 344.4)
  20685   "RTN","RCD PEWL7",354 ,0)
  20686    ;         TYPE="P" -  Pharmacy,  "T" - Tri care, "M"  - Medical
  20687   "RTN","RCD PEWL7",355 ,0)
  20688    ;         ("M" is ne ither phar macy nor T ricare)
  20689   "RTN","RCD PEWL7",356 ,0)
  20690    ; Return:  1 - Payer  on ERA ma tches the  TYPE
  20691   "RTN","RCD PEWL7",357 ,0)
  20692    ;          0 - Payer  on ERA do es not mat ch the typ e. Or can' t find pay er.
  20693   "RTN","RCD PEWL7",358 ,0)
  20694    ;
  20695   "RTN","RCD PEWL7",359 ,0)
  20696    N FLAG,RE TURN
  20697   "RTN","RCD PEWL7",360 ,0)
  20698    S RETURN= 0
  20699   "RTN","RCD PEWL7",361 ,0)
  20700    I '$$PAYF LAGS(IEN,. FLAG) Q 0
  20701   "RTN","RCD PEWL7",362 ,0)
  20702    I TYPE="P ",FLAG("P" ) S RETURN =1
  20703   "RTN","RCD PEWL7",363 ,0)
  20704    I TYPE="T ",FLAG("T" ) S RETURN =1
  20705   "RTN","RCD PEWL7",364 ,0)
  20706    I TYPE="M ",'FLAG("P "),'FLAG(" T") S RETU RN=1
  20707   "RTN","RCD PEWL7",365 ,0)
  20708    Q RETURN
  20709   "RTN","RCD PEWL7",366 ,0)
  20710    ;
  20711   "RTN","RCD PEWL7",367 ,0)
  20712   PAYFLAGS(I EN,FLAG) ;  EP - Retu rn the pha rmacy and  tricare fl ags for an  ERA
  20713   "RTN","RCD PEWL7",368 ,0)
  20714    ; Input:  IEN - Inte rnal entry  number of  an ERA (# 344.4)
  20715   "RTN","RCD PEWL7",369 ,0)
  20716    ; Return:  1 - Payer  found
  20717   "RTN","RCD PEWL7",370 ,0)
  20718    ;          0 - Can't  find paye r.
  20719   "RTN","RCD PEWL7",371 ,0)
  20720    ; Variabl e FLAG pas sed by ref erence to  return val ues of the  pharmacy  and Tricar e flags.
  20721   "RTN","RCD PEWL7",372 ,0)
  20722    ;
  20723   "RTN","RCD PEWL7",373 ,0)
  20724    N RCINS,R CPAYIEN,RC TIN,X
  20725   "RTN","RCD PEWL7",374 ,0)
  20726    S RCTIN=$ $GET1^DIQ( 344.4,IEN_ ",",.03)
  20727   "RTN","RCD PEWL7",375 ,0)
  20728    I RCTIN=" " Q 0
  20729   "RTN","RCD PEWL7",376 ,0)
  20730    S RCINS=$ $GET1^DIQ( 344.4,IEN_ ",",.06)
  20731   "RTN","RCD PEWL7",377 ,0)
  20732    I RCINS=" " Q 0
  20733   "RTN","RCD PEWL7",378 ,0)
  20734    ;
  20735   "RTN","RCD PEWL7",379 ,0)
  20736    ; Find a  payer that  matches b oth TIN an d PAYER NA ME from th e ERA
  20737   "RTN","RCD PEWL7",380 ,0)
  20738    S RCPAYIE N=""
  20739   "RTN","RCD PEWL7",381 ,0)
  20740    S X=0
  20741   "RTN","RCD PEWL7",382 ,0)
  20742    F  S X=$O (^RCY(344. 6,"C",RCTI N_" ",X))  Q:'X  D  Q :RCPAYIEN   ;
  20743   "RTN","RCD PEWL7",383 ,0)
  20744    . N PAYNA ME
  20745   "RTN","RCD PEWL7",384 ,0)
  20746    . S PAYNA ME=$$GET1^ DIQ(344.6, X_",",.01)
  20747   "RTN","RCD PEWL7",385 ,0)
  20748    . I PAYNA ME=RCINS S  RCPAYIEN= X
  20749   "RTN","RCD PEWL7",386 ,0)
  20750    I 'RCPAYI EN Q 0
  20751   "RTN","RCD PEWL7",387 ,0)
  20752    ;
  20753   "RTN","RCD PEWL7",388 ,0)
  20754    S FLAG("P ")=+$$GET1 ^DIQ(344.6 ,RCPAYIEN_ ",",.09,"I ")
  20755   "RTN","RCD PEWL7",389 ,0)
  20756    S FLAG("T ")=+$$GET1 ^DIQ(344.6 ,RCPAYIEN_ ",",.1,"I" )
  20757   "RTN","RCD PEWL7",390 ,0)
  20758    Q 1
  20759   "RTN","RCD PEWL7",391 ,0)
  20760    ;
  20761   "RTN","RCD PEWL7",392 ,0)
  20762    ; BEGIN P RCA*4.5*32 6
  20763   "RTN","RCD PEWL7",393 ,0)
  20764   HELP ; lis t manager  help
  20765   "RTN","RCD PEWL7",394 ,0)
  20766    D FULL^VA LM1
  20767   "RTN","RCD PEWL7",395 ,0)
  20768    S VALMBCK ="R"
  20769   "RTN","RCD PEWL7",396 ,0)
  20770    W @IOF
  20771   "RTN","RCD PEWL7",397 ,0)
  20772    W !,"ePay  Electroni c Remittan ce Advice  Status"
  20773   "RTN","RCD PEWL7",398 ,0)
  20774    W !!,"The  following  ERA Statu s indicato rs may app ear to the  left of E RA number: ",!
  20775   "RTN","RCD PEWL7",399 ,0)
  20776    ;
  20777   "RTN","RCD PEWL7",400 ,0)
  20778    W !," '-'  = No scra tchpad."
  20779   "RTN","RCD PEWL7",401 ,0)
  20780    W !," 'x'  = EXC exc eptions ex ist."
  20781   "RTN","RCD PEWL7",402 ,0)
  20782    W !," 'c'  = No-pay  ERA with a uto-decrea se CARCs."
  20783   "RTN","RCD PEWL7",403 ,0)
  20784    W !," 'A'  = Auto-po st complet e."
  20785   "RTN","RCD PEWL7",404 ,0)
  20786    W !," 'P'  = Auto-po st partial ly complet ed."
  20787   "RTN","RCD PEWL7",405 ,0)
  20788    W !," 'M'  = Marked  for Auto-p ost, waiti ng process ing."
  20789   "RTN","RCD PEWL7",406 ,0)
  20790    D PAUSE^V ALM1
  20791   "RTN","RCD PEWL7",407 ,0)
  20792    Q
  20793   "RTN","RCD PEWL7",408 ,0)
  20794    ; Followi ng FILTER  code moved  from RCDP EWL0 due t o routine  size
  20795   "RTN","RCD PEWL7",409 ,0)
  20796   FILTER(IEN 344P4) ; R eturns 1 i f record i n entry IE N344P4 in  344.4 pass es
  20797   "RTN","RCD PEWL7",410 ,0)
  20798    ; the edi ts for the  worklist  selection  of ERAs
  20799   "RTN","RCD PEWL7",411 ,0)
  20800    ; Paramet ers found  in ^TMP("R CERA_PARAM S",$J)
  20801   "RTN","RCD PEWL7",412 ,0)
  20802    N OK,RCPO ST,RCAPST, RCAPSTA,RC AUTOP,RCMA TCH,RCTYPE ,RCDFR,RCD TO,RCPAYFR ,RCPAYMNT, RCPAYTO,RC PAYR,RC0,R C4
  20803   "RTN","RCD PEWL7",413 ,0)
  20804    S OK=1,RC 0=$G(^RCY( 344.4,IEN3 44P4,0)),R C4=$G(^RCY (344.4,IEN 344P4,4))
  20805   "RTN","RCD PEWL7",414 ,0)
  20806    ;
  20807   "RTN","RCD PEWL7",415 ,0)
  20808    S RCMATCH =$G(^TMP(" RCERA_PARA MS",$J,"RC MATCH")),R CPOST=$G(^ TMP("RCERA _PARAMS",$ J,"RCPOST" ))
  20809   "RTN","RCD PEWL7",416 ,0)
  20810    S RCAUTOP =$G(^TMP(" RCERA_PARA MS",$J,"RC AUTOP")),R CTYPE=$G(^ TMP("RCERA _PARAMS",$ J,"RCTYPE" ))
  20811   "RTN","RCD PEWL7",417 ,0)
  20812    S RCDFR=+ $P($G(^TMP ("RCERA_PA RAMS",$J," RCDT")),U) ,RCDTO=+$P ($G(^TMP(" RCERA_PARA MS",$J,"RC DT")),U,2)
  20813   "RTN","RCD PEWL7",418 ,0)
  20814    S RCPAYR= $P($G(^TMP ("RCERA_PA RAMS",$J," RCPAYR")), U),RCPAYFR =$P($G(^TM P("RCERA_P ARAMS",$J, "RCPAYR")) ,U,2),RCPA YTO=$P($G( ^TMP("RCER A_PARAMS", $J,"RCPAYR ")),U,3)
  20815   "RTN","RCD PEWL7",419 ,0)
  20816    S RCPAYMN T=$G(^TMP( "RCERA_PAR AMS",$J,"R CPAYMNT"))     ; PRCA *4.5*321
  20817   "RTN","RCD PEWL7",420 ,0)
  20818    S RCAPSTA =$G(^TMP(" RCERA_PARA MS",$J,"RC APSTA"))
  20819   "RTN","RCD PEWL7",421 ,0)
  20820    ;
  20821   "RTN","RCD PEWL7",422 ,0)
  20822    ; Post st atus
  20823   "RTN","RCD PEWL7",423 ,0)
  20824    I $S(RCPO ST="B":0,R CPOST="U": $P(RC0,U,1 4),1:'$P(R C0,U,14))  S OK=0 G F Q
  20825   "RTN","RCD PEWL7",424 ,0)
  20826    ; Auto-Po sting stat us
  20827   "RTN","RCD PEWL7",425 ,0)
  20828    I $S(RCAU TOP="B":0, RCAUTOP="A ":($P(RC4, U,2)=""),1 :($P(RC4,U ,2)'=""))  S OK=0 G F Q
  20829   "RTN","RCD PEWL7",426 ,0)
  20830    ; If ERA  is autopos t and filt ering on s elected Au topost sta tuses chec k status
  20831   "RTN","RCD PEWL7",427 ,0)
  20832    I $P(RC4, U,2)'="",R CAPSTA'="A ",(RCAUTOP ="B")!(RCA UTOP="A")  D  G:OK=0  FQ
  20833   "RTN","RCD PEWL7",428 ,0)
  20834    .;Auto-po st Status
  20835   "RTN","RCD PEWL7",429 ,0)
  20836    .S RCAPST =$$GET1^DI Q(344.4,IE N344P4_"," ,4.02,"I")
  20837   "RTN","RCD PEWL7",430 ,0)
  20838    .;Complet e filter
  20839   "RTN","RCD PEWL7",431 ,0)
  20840    .I RCAPST A="C" S:RC APST'=2 OK =0 G FQ
  20841   "RTN","RCD PEWL7",432 ,0)
  20842    .;Partial  filter
  20843   "RTN","RCD PEWL7",433 ,0)
  20844    .I RCAPST A="P" S:RC APST'=1 OK =0 G FQ
  20845   "RTN","RCD PEWL7",434 ,0)
  20846    .;Marked  for Auto-p ost filter  - ignores  if not pa rtial post  or unpost ed
  20847   "RTN","RCD PEWL7",435 ,0)
  20848    .I RCAPST A="M",RCAP ST'=1,RCAP ST'=0 S OK =0 G FQ
  20849   "RTN","RCD PEWL7",436 ,0)
  20850    .;Marked  for Auto-p ost filter  - ignores  PARTIAL a uto-post e ra if no l ines on ER A are mark ed
  20851   "RTN","RCD PEWL7",437 ,0)
  20852    .I RCAPST A="M",RCAP ST=1,'$O(^ RCY(344.4, "AP",1,IEN 344P4,""))  S OK=0 G  FQ
  20853   "RTN","RCD PEWL7",438 ,0)
  20854    .;Marked  for Auto-p ost filter  - ignores  UNPROCESS ED auto-po st era if  no marked  for autopo st user 
  20855   "RTN","RCD PEWL7",439 ,0)
  20856    .I RCAPST A="M",RCAP ST=0,$$GET 1^DIQ(344. 4,IEN344P4 _",",4.04, "I")="" S  OK=0 G FQ
  20857   "RTN","RCD PEWL7",440 ,0)
  20858    ; Match s tatus
  20859   "RTN","RCD PEWL7",441 ,0)
  20860    I $S(RCMA TCH="B":0, RCMATCH="N ":$P(RC0,U ,9),1:'$P( RC0,U,9))  S OK=0 G F Q
  20861   "RTN","RCD PEWL7",442 ,0)
  20862    ; Medical /Pharmacy/ Tricare Cl aim
  20863   "RTN","RCD PEWL7",443 ,0)
  20864    ; I $S(RC TYPE="B":0 ,RCTYPE="M ":$$PHARM^ RCDPEWLP(I EN344P4),1 :'$$PHARM^ RCDPEWLP(I EN344P4))  S OK=0 G F Q
  20865   "RTN","RCD PEWL7",444 ,0)
  20866    I RCTYPE' ="A" D  I  'OK G FQ
  20867   "RTN","RCD PEWL7",445 ,0)
  20868    . N RCFLA G
  20869   "RTN","RCD PEWL7",446 ,0)
  20870    . I '$$PA YFLAGS^RCD PEWL7(IEN3 44P4,.RCFL AG) S OK=0  Q
  20871   "RTN","RCD PEWL7",447 ,0)
  20872    . I RCTYP E="P",'RCF LAG("P") S  OK=0 Q
  20873   "RTN","RCD PEWL7",448 ,0)
  20874    . I RCTYP E="T",'RCF LAG("T") S  OK=0 Q
  20875   "RTN","RCD PEWL7",449 ,0)
  20876    . I RCTYP E="M",(RCF LAG("P")!R CFLAG("T") ) S OK=0
  20877   "RTN","RCD PEWL7",450 ,0)
  20878    ; dt rec' d range
  20879   "RTN","RCD PEWL7",451 ,0)
  20880    I $S(RCDF R=0:0,1:$P (RC0,U,7)\ 1<RCDFR) S  OK=0 G FQ
  20881   "RTN","RCD PEWL7",452 ,0)
  20882    I $S(RCDT O=DT:0,1:$ P(RC0,U,7) \1>RCDTO)  S OK=0 G F Q
  20883   "RTN","RCD PEWL7",453 ,0)
  20884    ; Payer n ame
  20885   "RTN","RCD PEWL7",454 ,0)
  20886    I RCPAYR' ="A" D  G: 'OK FQ
  20887   "RTN","RCD PEWL7",455 ,0)
  20888    . N Q
  20889   "RTN","RCD PEWL7",456 ,0)
  20890    . S Q=$$U P^RCDPEARL ($P(RC0,U, 6))
  20891   "RTN","RCD PEWL7",457 ,0)
  20892    . I $S(Q= RCPAYFR:1, Q=RCPAYTO: 1,Q]RCPAYF R:RCPAYTO] Q,1:0) Q
  20893   "RTN","RCD PEWL7",458 ,0)
  20894    . S OK=0
  20895   "RTN","RCD PEWL7",459 ,0)
  20896    ; PRCA*4. 5*321 - St art modifi ed code bl ock
  20897   "RTN","RCD PEWL7",460 ,0)
  20898    ; Zero am ount or pa yment
  20899   "RTN","RCD PEWL7",461 ,0)
  20900    I RCPAYMN T'="B" D   ;
  20901   "RTN","RCD PEWL7",462 ,0)
  20902    . I RCPAY MNT="Z",$P (RC0,U,5)  S OK=0 Q
  20903   "RTN","RCD PEWL7",463 ,0)
  20904    . I RCPAY MNT="P",'$ P(RC0,U,5)  S OK=0
  20905   "RTN","RCD PEWL7",464 ,0)
  20906    ; PRCA*4. 5*321 - En d modified  code bloc k
  20907   "RTN","RCD PEWL7",465 ,0)
  20908    ;
  20909   "RTN","RCD PEWL7",466 ,0)
  20910   FQ Q OK
  20911   "RTN","RCD PEWL7",467 ,0)
  20912    ; END PRC A*4.5*326
  20913   "RTN","RCD PEWLP")
  20914   0^23^B2011 14317
  20915   "RTN","RCD PEWLP",1,0 )
  20916   RCDPEWLP ; ALBANY/KML  - EDI LOC KBOX ERA a nd EEOB WO RKLIST pro cedures ;1 0 Oct 2018  11:49:24
  20917   "RTN","RCD PEWLP",2,0 )
  20918    ;;4.5;Acc ounts Rece ivable;**2 98,303,304 ,319,332** ;Mar 20, 1 995;Build  34
  20919   "RTN","RCD PEWLP",3,0 )
  20920    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  20921   "RTN","RCD PEWLP",4,0 )
  20922    ;
  20923   "RTN","RCD PEWLP",5,0 )
  20924    Q
  20925   "RTN","RCD PEWLP",6,0 )
  20926    ;
  20927   "RTN","RCD PEWLP",7,0 )
  20928    ; PRCA*4. 5*298 - ha ndle outst anding EFT s & ERAs w ith except ions
  20929   "RTN","RCD PEWLP",8,0 )
  20930    ;
  20931   "RTN","RCD PEWLP",9,0 )
  20932   AGEDEFTS(E RADA,TYPE)  ;function , Search m edical or  pharmacy a ged EFTs t hat have n ot been po sted 
  20933   "RTN","RCD PEWLP",10, 0)
  20934    ; ENTRY p oint for t he Select  ERA action  on the ER A Worklist  screen
  20935   "RTN","RCD PEWLP",11, 0)
  20936    ; Input:    ERADA -  IEN in fil e 344.4
  20937   "RTN","RCD PEWLP",12, 0)
  20938    ;           TYPE     - Medical,  Pharmacy  or Tricare  (M,P, T)
  20939   "RTN","RCD PEWLP",13, 0)
  20940    ; Returns
  20941   "RTN","RCD PEWLP",14, 0)
  20942    ; "1P" Er ror for ag ed, unpost ed pharmac y EFTs
  20943   "RTN","RCD PEWLP",15, 0)
  20944    ; "2P" Wa rning for  aged,unpos ted pharma cy EFTs
  20945   "RTN","RCD PEWLP",16, 0)
  20946    ; "3P" Ov erride exi sts for ag ed, unpost ed pharmac y EFTs
  20947   "RTN","RCD PEWLP",17, 0)
  20948    ; "1M" Er ror for ag ed, unpost ed medical  EFTs
  20949   "RTN","RCD PEWLP",18, 0)
  20950    ; "2M" Wa rning for  aged, unpo sted medic al EFTs
  20951   "RTN","RCD PEWLP",19, 0)
  20952    ; "3M" Ov erride exi sts for ag ed, unpost ed medical  EFTs
  20953   "RTN","RCD PEWLP",20, 0)
  20954    ; "1T" Er ror for ag ed, unpost ed Tricare  EFTs
  20955   "RTN","RCD PEWLP",21, 0)
  20956    ; "2T" Wa rning for  aged, unpo sted Trica re EFTs
  20957   "RTN","RCD PEWLP",22, 0)
  20958    ; "3T" Ov erride exi sts for ag ed, unpost ed Tricare  EFTs
  20959   "RTN","RCD PEWLP",23, 0)
  20960    ;  0   No  error or  warning co nditions
  20961   "RTN","RCD PEWLP",24, 0)
  20962    ;  NOTE:  may be mor e than one  - "1P" or  "2P" or " 3P" or "3P ^2M" or "3 P^3M", etc .
  20963   "RTN","RCD PEWLP",25, 0)
  20964    ;
  20965   "RTN","RCD PEWLP",26, 0)
  20966    ;for acti on Select  ERA:
  20967   "RTN","RCD PEWLP",27, 0)
  20968    ; 1. If u nposted pa yments (EF Ts) associ ated with  3rd party  Medical cl aims > tha n 14 days,  display W ARNING mes sage for a ction 
  20969   "RTN","RCD PEWLP",28, 0)
  20970    ;    Sele ct ERA on  the ERA WO RKLIST, al low user t o enter th e worklist
  20971   "RTN","RCD PEWLP",29, 0)
  20972    ; 2. If t here are u nposted pa yments (EF Ts) associ ated with  Pharmacy c laims > 21  days, dis play a WAR NING messa ge
  20973   "RTN","RCD PEWLP",30, 0)
  20974    ;    on t he ERA WOR KLIST, ent er worklis t
  20975   "RTN","RCD PEWLP",31, 0)
  20976    ; 3. If t here are u nposted pa yments (EF Ts) associ ated with  3rd party  Tricare cl aims 
  20977   "RTN","RCD PEWLP",32, 0)
  20978    ;    > 14  calendar  days, disp lay WARNIN G message,  enter wor klist
  20979   "RTN","RCD PEWLP",33, 0)
  20980    ; 4. If t here are u nposted pa yments (EF Ts) associ ated with  3rd party  medical, p harmacy or
  20981   "RTN","RCD PEWLP",34, 0)
  20982    ;    Tric are claims , aged > t he number  of days in  site para meters, di splay erro r message
  20983   "RTN","RCD PEWLP",35, 0)
  20984    ;addition al criteri a for item  3:
  20985   "RTN","RCD PEWLP",36, 0)
  20986    ;create s cratchpad  if:
  20987   "RTN","RCD PEWLP",37, 0)
  20988    ; 3a. med ical ERA i s 14 days  or older
  20989   "RTN","RCD PEWLP",38, 0)
  20990    ; 3b. pha rmacy ERA  is 21 days  or older
  20991   "RTN","RCD PEWLP",39, 0)
  20992    ; 3c. Tri care ERA i s 14 days  or older
  20993   "RTN","RCD PEWLP",40, 0)
  20994    ; 3d. If  override e xists
  20995   "RTN","RCD PEWLP",41, 0)
  20996    ;DO NOT c reate scra tchpad if  no overrid e and:
  20997   "RTN","RCD PEWLP",42, 0)
  20998    ; 3e. med ical ERA r eceived wi thin 14 da ys and the re are age d, unposte d EFTs
  20999   "RTN","RCD PEWLP",43, 0)
  21000    ; 3f. pha rmacy ERA  received w ithin 21 d ays and th ere are ag ed, unpost ed EFTs
  21001   "RTN","RCD PEWLP",44, 0)
  21002    ; 3g. Tri care ERA r eceived wi thin 14 da ys and the re are age d, unposte d EFTs
  21003   "RTN","RCD PEWLP",45, 0)
  21004    ;
  21005   "RTN","RCD PEWLP",46, 0)
  21006    ;Do not c onsider EF Ts older t han two mo nths prior  to nation al release
  21007   "RTN","RCD PEWLP",47, 0)
  21008    ;Note: EF Ts to be a uto-posted  to a rece ipt includ ed in sear ch for age d, unposte d EFTs
  21009   "RTN","RCD PEWLP",48, 0)
  21010    N DATE,EF TDA,EFT0,R C3444,RC34 431,SELERA DT,UNPOST, X
  21011   "RTN","RCD PEWLP",49, 0)
  21012    S UNPOST= 0
  21013   "RTN","RCD PEWLP",50, 0)
  21014    S RC3444= ^RCY(344.4 ,ERADA,0)
  21015   "RTN","RCD PEWLP",51, 0)
  21016    I '$P(RC3 444,U,5) G  AEFTSQ  ;  skip ERAs  with zero  payment 
  21017   "RTN","RCD PEWLP",52, 0)
  21018    S EFTDA=+ $O(^RCY(34 4.31,"AERA ",ERADA,0) )
  21019   "RTN","RCD PEWLP",53, 0)
  21020    S:EFTDA R C34431=^RC Y(344.31,E FTDA,0)
  21021   "RTN","RCD PEWLP",54, 0)
  21022    I 'EFTDA, $P(RC3444, U,9)=2 G A EFTSQ  ; I gnore sele cted ERAs  that are M ATCHED TO  PAPER CHEC K
  21023   "RTN","RCD PEWLP",55, 0)
  21024    ;
  21025   "RTN","RCD PEWLP",56, 0)
  21026    ; skip un matched ER As with EX PECTED PAY MENT CODE  "CHK"
  21027   "RTN","RCD PEWLP",57, 0)
  21028    I 'EFTDA, $P(RC3444, U,15)="CHK " G AEFTSQ
  21029   "RTN","RCD PEWLP",58, 0)
  21030    ;
  21031   "RTN","RCD PEWLP",59, 0)
  21032    ; Use FIL E DATE/TIM E (344.4,  .07) of ER A if no EF T (unmatch ed ERA),
  21033   "RTN","RCD PEWLP",60, 0)
  21034    ; else us e DATE REC EIVED (344 .31,.13) o f EFT asso ciated wit h ERA 
  21035   "RTN","RCD PEWLP",61, 0)
  21036    S SELERAD T=$S('EFTD A:$P($P(RC 3444,U,7), "."),1:$P( RC34431,U, 13))
  21037   "RTN","RCD PEWLP",62, 0)
  21038    ;
  21039   "RTN","RCD PEWLP",63, 0)
  21040    I TYPE="P " D  G AEF TSQ
  21041   "RTN","RCD PEWLP",64, 0)
  21042    . I $$FMD IFF^XLFDT( DT,SELERAD T)>21 S UN POST=0 Q   ;ERA older  than 21 d ays, enter  scratchpa d
  21043   "RTN","RCD PEWLP",65, 0)
  21044    . S UNPOS T=$$GETEFT S(TYPE)  ; NOT older  than 21 da ys, get un posted, ag ed EFTs
  21045   "RTN","RCD PEWLP",66, 0)
  21046    ;
  21047   "RTN","RCD PEWLP",67, 0)
  21048    I TYPE="M " D  G AEF TSQ
  21049   "RTN","RCD PEWLP",68, 0)
  21050    . I $$FMD IFF^XLFDT( DT,SELERAD T)>14 S UN POST=0 Q   ;ERA older  than 14 d ays, enter  scratchpa d
  21051   "RTN","RCD PEWLP",69, 0)
  21052    . S UNPOS T=$$GETEFT S(TYPE)  ; NOT older  than 14 da ys, get un posted, ag ed EFTs
  21053   "RTN","RCD PEWLP",70, 0)
  21054    ;
  21055   "RTN","RCD PEWLP",71, 0)
  21056    I TYPE="T " D  G AEF TSQ
  21057   "RTN","RCD PEWLP",72, 0)
  21058    . I $$FMD IFF^XLFDT( DT,SELERAD T)>14 S UN POST=0 Q   ;ERA older  than 14 d ays, enter  scratchpa d
  21059   "RTN","RCD PEWLP",73, 0)
  21060    . S UNPOS T=$$GETEFT S(TYPE)  ; NOT older  than 14 da ys, get un posted, ag ed EFTs
  21061   "RTN","RCD PEWLP",74, 0)
  21062    ;
  21063   "RTN","RCD PEWLP",75, 0)
  21064   AEFTSQ ; s ingle exit  for funct ion
  21065   "RTN","RCD PEWLP",76, 0)
  21066    Q UNPOST
  21067   "RTN","RCD PEWLP",77, 0)
  21068    ;
  21069   "RTN","RCD PEWLP",78, 0)
  21070   GETEFTS(TY PE,OPTION)  ;function , EP from  RCDPEUPO f or Unposte d EFT Over ride optio
  21071   "RTN","RCD PEWLP",79, 0)
  21072    ; Set up  search cri teria for  unposted E FTs. If ag ed, unpost ed EFTs cr eate warni ng/prevent ion messag es
  21073   "RTN","RCD PEWLP",80, 0)
  21074    ; TYPE: " M" (Medica l ERA-EFT) , "P" (Pha macy ERA-E FT), "T" ( Tricare ER A-EFT), "A " (Medical , Pharmacy  & Tricare )
  21075   "RTN","RCD PEWLP",81, 0)
  21076    ;OPTION:
  21077   "RTN","RCD PEWLP",82, 0)
  21078    ;  null i f Called b y Select E RA action  on ERA Wor klist
  21079   "RTN","RCD PEWLP",83, 0)
  21080    ;  1 if C alled by R CDPE UNPOS TED EFT OV ERRIDE opt ion
  21081   "RTN","RCD PEWLP",84, 0)
  21082    ; Returns : See outp ut for AGE DEFTS
  21083   "RTN","RCD PEWLP",85, 0)
  21084    ;
  21085   "RTN","RCD PEWLP",86, 0)
  21086    N ARRAY,D AYSLIMT,DT ARRY,OUTCO ME,OVERRID E,STARTDT, STR,TRARRY ,X
  21087   "RTN","RCD PEWLP",87, 0)
  21088    S OPTION= $G(OPTION)
  21089   "RTN","RCD PEWLP",88, 0)
  21090    I TYPE="A " D  ; Ret rieve all  Aged Days  limits
  21091   "RTN","RCD PEWLP",89, 0)
  21092    . S DAYSL IMT("M")=$ $GET1^DIQ( 344.61,1,. 06)  ; Med ical
  21093   "RTN","RCD PEWLP",90, 0)
  21094    . S DAYSL IMT("P")=$ $GET1^DIQ( 344.61,1,. 07)  ; Pha rmacy
  21095   "RTN","RCD PEWLP",91, 0)
  21096    . S DAYSL IMT("T")=$ $GET1^DIQ( 344.61,1,. 13)  ; Tri care
  21097   "RTN","RCD PEWLP",92, 0)
  21098    ; Retriev e Aged Day s limit fo r specifie d type
  21099   "RTN","RCD PEWLP",93, 0)
  21100    I '(TYPE= "A") S DAY SLIMT(TYPE )=$$GET1^D IQ(344.61, 1,$S(TYPE= "M":.06,TY PE="P":.07 ,1:.13))
  21101   "RTN","RCD PEWLP",94, 0)
  21102    S STARTDT =$$CUTOFF
  21103   "RTN","RCD PEWLP",95, 0)
  21104    D EFTDET( STARTDT,TY PE,.DAYSLI MT,.TRARRY )
  21105   "RTN","RCD PEWLP",96, 0)
  21106    ;
  21107   "RTN","RCD PEWLP",97, 0)
  21108    ; Aged un posted EFT s exist. C reate prev ention mes sage and i f called w ithin
  21109   "RTN","RCD PEWLP",98, 0)
  21110    ; the Wor klist (not  Override  option) pl us msg. wi th list of  TRACE #s
  21111   "RTN","RCD PEWLP",99, 0)
  21112    F X="M"," P","T" D
  21113   "RTN","RCD PEWLP",100 ,0)
  21114    . I $D(TR ARRY("ERRO R",X)) D
  21115   "RTN","RCD PEWLP",101 ,0)
  21116    ..  D CHE CK^RCDPEUP O(X,.OVERR IDE)           ; Dete rmine if O verride ex ists
  21117   "RTN","RCD PEWLP",102 ,0)
  21118    ..  I OVE RRIDE S OU TCOME=$G(O UTCOME)_3_ X_U Q
  21119   "RTN","RCD PEWLP",103 ,0)
  21120    ..  S OUT COME=$G(OU TCOME)_1_X _U
  21121   "RTN","RCD PEWLP",104 ,0)
  21122    ..  ; do  not displa y warning  msg if err or conditi on exists
  21123   "RTN","RCD PEWLP",105 ,0)
  21124    ..  K TRA RRY("WARNI NG",X)
  21125   "RTN","RCD PEWLP",106 ,0)
  21126    ..  Q:OPT ION  Q:OVE RRIDE
  21127   "RTN","RCD PEWLP",107 ,0)
  21128    ..  Q:(TY PE'="A"&(T YPE'=X))   ; Only sho w error me ssages for  TYPE
  21129   "RTN","RCD PEWLP",108 ,0)
  21130    ..  M ARR AY=TRARRY( "ERROR",X)
  21131   "RTN","RCD PEWLP",109 ,0)
  21132    ..  D FTR ACE(.ARRAY ,.STR),PRE VMSG(X,.DA YSLIMT,.ST R)
  21133   "RTN","RCD PEWLP",110 ,0)
  21134    ..  K ARR AY
  21135   "RTN","RCD PEWLP",111 ,0)
  21136    ;
  21137   "RTN","RCD PEWLP",112 ,0)
  21138    F X="M"," P","T" D
  21139   "RTN","RCD PEWLP",113 ,0)
  21140    . I $D(TR ARRY("WARN ING",X)) D
  21141   "RTN","RCD PEWLP",114 ,0)
  21142    ..  S OUT COME=$G(OU TCOME)_2_X _U
  21143   "RTN","RCD PEWLP",115 ,0)
  21144    ..  Q:OPT ION  ; Cal led by OVE RRIDE opti on, no tra ce number  list
  21145   "RTN","RCD PEWLP",116 ,0)
  21146    ..  Q:(TY PE'="A"&(T YPE'=X))   ; Only sho w warning  messages f or TYPE
  21147   "RTN","RCD PEWLP",117 ,0)
  21148    ..  M ARR AY=TRARRY( "WARNING", X)
  21149   "RTN","RCD PEWLP",118 ,0)
  21150    ..  D FTR ACE(.ARRAY ,.STR),WAR NMSG(X,.ST R)
  21151   "RTN","RCD PEWLP",119 ,0)
  21152    ..  K ARR AY ; aged  unposted E FTs > 21 d ays exist,  generate  warning me ssage
  21153   "RTN","RCD PEWLP",120 ,0)
  21154    ;
  21155   "RTN","RCD PEWLP",121 ,0)
  21156    S:'$D(OUT COME) OUTC OME=0  ; n o error or  warnings
  21157   "RTN","RCD PEWLP",122 ,0)
  21158    ;
  21159   "RTN","RCD PEWLP",123 ,0)
  21160    Q OUTCOME
  21161   "RTN","RCD PEWLP",124 ,0)
  21162    ;
  21163   "RTN","RCD PEWLP",125 ,0)
  21164   CUTOFF() ;  Returns E FT Cutoff  date
  21165   "RTN","RCD PEWLP",126 ,0)
  21166    ; date is  2 months  prior to i nstall dat e of patch  298, igno re aged EF TS older t han that
  21167   "RTN","RCD PEWLP",127 ,0)
  21168    N RCX S R CX=+$P($G( ^RCY(344.6 1,1,0)),U, 9)
  21169   "RTN","RCD PEWLP",128 ,0)
  21170    S:RCX=0 R CX=DT
  21171   "RTN","RCD PEWLP",129 ,0)
  21172    Q $$FMADD ^XLFDT(RCX ,-61,0,0)
  21173   "RTN","RCD PEWLP",130 ,0)
  21174    ;
  21175   "RTN","RCD PEWLP",131 ,0)
  21176   EFTDET(REC VDT,TYPE,D AYSLIMT,TR ARRY) ; Ga ther EFT d ata, Only  EFTs that  are aged a nd unposte d
  21177   "RTN","RCD PEWLP",132 ,0)
  21178    ;Input: 
  21179   "RTN","RCD PEWLP",133 ,0)
  21180    ; RECVDT  - start da te in DATE  RECEIVED  cross-refe rence of f ile 344.3
  21181   "RTN","RCD PEWLP",134 ,0)
  21182    ; TYPE- " M" - (Medi cal ERA-EF T), "P" (P hamacy ERA -EFT), "T"  (TRICARE  ERA-EFT),  "A" (Medic al, Pharma cy and Tri care)
  21183   "RTN","RCD PEWLP",135 ,0)
  21184    ; DAYSLIM T - days E FT can age  before po st prevent ion rules  apply
  21185   "RTN","RCD PEWLP",136 ,0)
  21186    ;Output:
  21187   "RTN","RCD PEWLP",137 ,0)
  21188    ; TRARRY  - Array of  trace num bers of th e aged, un posted EFT s
  21189   "RTN","RCD PEWLP",138 ,0)
  21190    ;  
  21191   "RTN","RCD PEWLP",139 ,0)
  21192    N EFTDA
  21193   "RTN","RCD PEWLP",140 ,0)
  21194    F  S RECV DT=$O(^RCY (344.31,"A DR",RECVDT )) Q:'RECV DT  D
  21195   "RTN","RCD PEWLP",141 ,0)
  21196    . S EFTDA ="" F  S E FTDA=$O(^R CY(344.31, "ADR",RECV DT,EFTDA))  Q:'EFTDA   D
  21197   "RTN","RCD PEWLP",142 ,0)
  21198    ..  D CHK EFT(RECVDT ,EFTDA,TYP E,.DAYSLIM T,.TRARRY)
  21199   "RTN","RCD PEWLP",143 ,0)
  21200    Q
  21201   "RTN","RCD PEWLP",144 ,0)
  21202    ;
  21203   "RTN","RCD PEWLP",145 ,0)
  21204   CHKEFT(REC VDT,EFTDA, TYPE,DAYSL IMT,TRARRY ) ; Check  EFT for wa rnings/err ors
  21205   "RTN","RCD PEWLP",146 ,0)
  21206    ;Input:
  21207   "RTN","RCD PEWLP",147 ,0)
  21208    ; RECVDT  - Date Rec eived
  21209   "RTN","RCD PEWLP",148 ,0)
  21210    ; EFTDA -  IEN of ED I THIRD PA RY EFT DET AIL
  21211   "RTN","RCD PEWLP",149 ,0)
  21212    ; TYPE -  "M" (Medic al ERA-EFT ), "P" (Ph amacy ERA- EFT), "T"( Tricare ER A-EFT), "A " (Medical , Pharmacy  and Trica re)
  21213   "RTN","RCD PEWLP",150 ,0)
  21214    ; DAYSLIM T  - days  an EFT can  age befor e post pre vention ru les apply 
  21215   "RTN","RCD PEWLP",151 ,0)
  21216    ; TRARRY     - Array  with warn ing error  info
  21217   "RTN","RCD PEWLP",152 ,0)
  21218    ;
  21219   "RTN","RCD PEWLP",153 ,0)
  21220    N AGED,EF TTYPE,ERAR EC,MSTATUS ,TRACE
  21221   "RTN","RCD PEWLP",154 ,0)
  21222    Q:$G(^RCY (344.31,EF TDA,0))=""   ; skip,  no data
  21223   "RTN","RCD PEWLP",155 ,0)
  21224    Q:+$$GET1 ^DIQ(344.3 1,EFTDA_", ",.07,"I") =0  ; skip , zero pay ment amt.
  21225   "RTN","RCD PEWLP",156 ,0)
  21226    ;
  21227   "RTN","RCD PEWLP",157 ,0)
  21228    ; Ignore  duplicate  EFTs which  have been  removed 
  21229   "RTN","RCD PEWLP",158 ,0)
  21230    Q:$$GET1^ DIQ(344.31 ,EFTDA_"," ,.18,"I")   ;^DD(344. 31,.18,0)= "DATE/TIME  DUPLICATE  REMOVED
  21231   "RTN","RCD PEWLP",159 ,0)
  21232    S ERAREC= +$$GET1^DI Q(344.31,E FTDA_",",. 1,"I")  ;  Pointer to  ERA recor d
  21233   "RTN","RCD PEWLP",160 ,0)
  21234    I ERAREC, $$GET1^DIQ (344.4,ERA REC_",",.1 4,"I")=1 Q   ; Ignore  posted ER A-EFTs 
  21235   "RTN","RCD PEWLP",161 ,0)
  21236    ;
  21237   "RTN","RCD PEWLP",162 ,0)
  21238    ; Exclude  EFT match ed to Pape r EOB if r eceipt is  processed
  21239   "RTN","RCD PEWLP",163 ,0)
  21240    I 'ERAREC ,$$GET1^DI Q(344.31,E FTDA_",",. 08,"I") Q: $$PROC(EFT DA)
  21241   "RTN","RCD PEWLP",164 ,0)
  21242    S MSTATUS =+$$GET1^D IQ(344.31, EFTDA_",", .08,"I")   ; MATCH ST ATUS
  21243   "RTN","RCD PEWLP",165 ,0)
  21244    S AGED=$$ FMDIFF^XLF DT(DT,RECV DT)  ; day s aged for  EFT
  21245   "RTN","RCD PEWLP",166 ,0)
  21246    S TRACE=$ $GET1^DIQ( 344.31,EFT DA_",",.04 ,"I")  ; T RACE #
  21247   "RTN","RCD PEWLP",167 ,0)
  21248    S:TRACE=" " TRACE="( No trace # )"
  21249   "RTN","RCD PEWLP",168 ,0)
  21250    ; no ERA,  cannot ev aluate fur ther
  21251   "RTN","RCD PEWLP",169 ,0)
  21252    I 'ERAREC  D  Q  ;
  21253   "RTN","RCD PEWLP",170 ,0)
  21254    . S EFTTY PE=$S($$IS TYPE^RCDPE U1(344.31, EFTDA,"P") :"P",$$IST YPE^RCDPEU 1(344.31,E FTDA,"T"): "T",1:"M")
  21255   "RTN","RCD PEWLP",171 ,0)
  21256    . S TRARR Y("WARNING ",EFTTYPE, TRACE)="No  ERA found "_U_MSTATU S
  21257   "RTN","RCD PEWLP",172 ,0)
  21258    ;
  21259   "RTN","RCD PEWLP",173 ,0)
  21260    I (TYPE=" A")!(TYPE= "P"),$$PHA RM(ERAREC)  D  Q
  21261   "RTN","RCD PEWLP",174 ,0)
  21262    . ; Aged,  unposted  EFT gets e rror messa ge, no scr atchpad fo r the ERA
  21263   "RTN","RCD PEWLP",175 ,0)
  21264    . I AGED> DAYSLIMT(" P") S TRAR RY("ERROR" ,"P",TRACE )="ERA = " _ERAREC_U_ MSTATUS Q
  21265   "RTN","RCD PEWLP",176 ,0)
  21266    . ; Aged,  unposted  PHARMACY E FT display  warning m essage whe n entering  scratchpa d with the  ERA
  21267   "RTN","RCD PEWLP",177 ,0)
  21268    . I '$D(T RARRY("ERR OR")),AGED >21 S TRAR RY("WARNIN G","P",TRA CE)="ERA =  "_ERAREC_ U_MSTATUS
  21269   "RTN","RCD PEWLP",178 ,0)
  21270    ;
  21271   "RTN","RCD PEWLP",179 ,0)
  21272    I (TYPE=" A")!(TYPE= "T"),$$IST YPE^RCDPEU 1(344.31,E FTDA,"T")  D  Q  ; is  payer typ e Tricare?
  21273   "RTN","RCD PEWLP",180 ,0)
  21274    . ; Aged,  unposted  EFT gets e rror messa ge, no scr atchpad fo r the ERA
  21275   "RTN","RCD PEWLP",181 ,0)
  21276    . I AGED> DAYSLIMT(" T") S TRAR RY("ERROR" ,"T",TRACE )="ERA = " _ERAREC_U_ MSTATUS Q
  21277   "RTN","RCD PEWLP",182 ,0)
  21278    . ; Aged,  unposted  MEDICAL EF T display  warning me ssage when  entering  scratchpad  with the  ERA
  21279   "RTN","RCD PEWLP",183 ,0)
  21280    . I '$D(T RARRY("ERR OR")),AGED >14 S TRAR RY("WARNIN G","T",TRA CE)="ERA =  "_ERAREC_ U_MSTATUS
  21281   "RTN","RCD PEWLP",184 ,0)
  21282    ;
  21283   "RTN","RCD PEWLP",185 ,0)
  21284    I (TYPE=" A")!(TYPE= "M"),'$$PH ARM(ERAREC ) D
  21285   "RTN","RCD PEWLP",186 ,0)
  21286    . I AGED> DAYSLIMT(" M") S TRAR RY("ERROR" ,"M",TRACE )="ERA = " _ERAREC_U_ MSTATUS Q
  21287   "RTN","RCD PEWLP",187 ,0)
  21288    . ; Aged,  unposted  MEDICAL EF T warning  message wh en enterin g scratchp ad with ER A
  21289   "RTN","RCD PEWLP",188 ,0)
  21290    . I '$D(T RARRY("ERR OR")),AGED >14 S TRAR RY("WARNIN G","M",TRA CE)="ERA =  "_ERAREC_ U_MSTATUS
  21291   "RTN","RCD PEWLP",189 ,0)
  21292    ;
  21293   "RTN","RCD PEWLP",190 ,0)
  21294    Q
  21295   "RTN","RCD PEWLP",191 ,0)
  21296    ;
  21297   "RTN","RCD PEWLP",192 ,0)
  21298   PROC(EFTDA ) ; Check  if TR Rece ipt for an  EFT linke d to Paper  EOB is pr ocessed 
  21299   "RTN","RCD PEWLP",193 ,0)
  21300    ; Input:    EFTDA -  IEN for fi le 344.31
  21301   "RTN","RCD PEWLP",194 ,0)
  21302    ; Returns : 1 if TR  receipt ex ists and i s OPEN, 0  otherwise
  21303   "RTN","RCD PEWLP",195 ,0)
  21304    N IEN344, RET S RET= 0
  21305   "RTN","RCD PEWLP",196 ,0)
  21306    ; Find TR  receipt a nd check i f status i s not CLOS ED
  21307   "RTN","RCD PEWLP",197 ,0)
  21308    S IEN344= $O(^RCY(34 4,"AEFT",E FTDA,0))
  21309   "RTN","RCD PEWLP",198 ,0)
  21310    I IEN344, $$GET1^DIQ (344,IEN34 4_",",.14, "I")'=1 S  RET=1
  21311   "RTN","RCD PEWLP",199 ,0)
  21312    Q RET
  21313   "RTN","RCD PEWLP",200 ,0)
  21314    ;
  21315   "RTN","RCD PEWLP",201 ,0)
  21316   FTRACE(TRA RRY,STR) ;  both args . passed b y ref.
  21317   "RTN","RCD PEWLP",202 ,0)
  21318    ; TRARRY   - trace n umbers of  aged, unpo sted EFTs
  21319   "RTN","RCD PEWLP",203 ,0)
  21320    ; returns : STR - ar ray of tra ce numbers  separated  by commas  for warni ng or erro r message
  21321   "RTN","RCD PEWLP",204 ,0)
  21322    N CTR,LEN ,TRACE,X
  21323   "RTN","RCD PEWLP",205 ,0)
  21324    K STR S C TR=1,TRACE =""
  21325   "RTN","RCD PEWLP",206 ,0)
  21326    F  S TRAC E=$O(TRARR Y(TRACE))  Q:TRACE=""   D
  21327   "RTN","RCD PEWLP",207 ,0)
  21328    . S STR(C TR)=$G(STR (CTR))  ;  Initialize
  21329   "RTN","RCD PEWLP",208 ,0)
  21330    . I $L(ST R(CTR))+$L (TRACE)>77  S CTR=CTR +1,STR(CTR )=TRACE Q
  21331   "RTN","RCD PEWLP",209 ,0)
  21332    . S STR(C TR)=STR(CT R)_$S(STR( CTR)]"":", ",1:"")_TR ACE  ; com ma if need ed
  21333   "RTN","RCD PEWLP",210 ,0)
  21334    Q 
  21335   "RTN","RCD PEWLP",211 ,0)
  21336    ;
  21337   "RTN","RCD PEWLP",212 ,0)
  21338   WARNMSG(TY PE,STR) ;  warning me ssage when  aged, unp osted EFTs  exist
  21339   "RTN","RCD PEWLP",213 ,0)
  21340    ; Input:  TYPE - "M"  - Medical , "P" - Ph armacy or  "T" - Tric are
  21341   "RTN","RCD PEWLP",214 ,0)
  21342    ; STR - A rray, subs cripts are  strings i n "trace#,  trace#,"  format
  21343   "RTN","RCD PEWLP",215 ,0)
  21344    N DIR,LN, X,Y
  21345   "RTN","RCD PEWLP",216 ,0)
  21346    S DIR(0)= "EA"
  21347   "RTN","RCD PEWLP",217 ,0)
  21348    S DIR("A" ,1)="WARNI NG: Unpost ed "_$S(TY PE="P":"ph armacy",TY PE="M":"me dical",1:" TRICARE")
  21349   "RTN","RCD PEWLP",218 ,0)
  21350    S DIR("A" ,1)=DIR("A ",1)_" EFT s exist th at are mor e than "_$ S(TYPE="P" :21,1:14)_ " days old ."
  21351   "RTN","RCD PEWLP",219 ,0)
  21352    S DIR("A" ,2)=" "
  21353   "RTN","RCD PEWLP",220 ,0)
  21354    S DIR("A" ,3)="Post  the older  payments f irst. The  EFTs may b e unmatche d or match ed."
  21355   "RTN","RCD PEWLP",221 ,0)
  21356    S DIR("A" ,4)="Trace  number(s)  associate d with unp osted EFTs :"
  21357   "RTN","RCD PEWLP",222 ,0)
  21358    S LN=4,X= 0 F  S X=$ O(STR(X))  Q:'X  S LN =LN+1,DIR( "A",LN)=ST R(X)
  21359   "RTN","RCD PEWLP",223 ,0)
  21360    S LN=LN+1 ,DIR("A",L N)=" "
  21361   "RTN","RCD PEWLP",224 ,0)
  21362    S DIR("A" )="Press E NTER to co ntinue: "
  21363   "RTN","RCD PEWLP",225 ,0)
  21364    W !
  21365   "RTN","RCD PEWLP",226 ,0)
  21366    D ^DIR
  21367   "RTN","RCD PEWLP",227 ,0)
  21368    Q
  21369   "RTN","RCD PEWLP",228 ,0)
  21370    ;
  21371   "RTN","RCD PEWLP",229 ,0)
  21372   PREVMSG(TY PE,DAYS,ST R) ; Displ ay Error m essage whe n aged, un posted EFT s exist
  21373   "RTN","RCD PEWLP",230 ,0)
  21374    ;Input:
  21375   "RTN","RCD PEWLP",231 ,0)
  21376    ; TYPE -  "M":Medica l, "P":Pha rmacy, "T" :Tricare
  21377   "RTN","RCD PEWLP",232 ,0)
  21378    ; DAYS -  days EFT c an age bef ore post p revention  rules appl y
  21379   "RTN","RCD PEWLP",233 ,0)
  21380    ; STR - A rray, each  subscrpt  is string  of trace n umbers in  "trace#, t race#," fo rmat     
  21381   "RTN","RCD PEWLP",234 ,0)
  21382    ;
  21383   "RTN","RCD PEWLP",235 ,0)
  21384    N DIR,LN, X,Y
  21385   "RTN","RCD PEWLP",236 ,0)
  21386    S DIR(0)= "EA"
  21387   "RTN","RCD PEWLP",237 ,0)
  21388    S DIR("A" ,1)="ERROR : Unposted  "_$S(TYPE ="P":"Phar macy",TYPE ="M":"Medi cal",1:"TR ICARE")
  21389   "RTN","RCD PEWLP",238 ,0)
  21390    S DIR("A" ,1)=DIR("A ",1)_" EFT s exist th at are mor e than "_D AYS(TYPE)_ " days old . Scratchp ad"
  21391   "RTN","RCD PEWLP",239 ,0)
  21392    S DIR("A" ,2)="creat ion is not  allowed f or newer p ayments. P ost older  payments f irst."
  21393   "RTN","RCD PEWLP",240 ,0)
  21394    S DIR("A" ,3)="The E FTs may be  matched o r unmatche d."
  21395   "RTN","RCD PEWLP",241 ,0)
  21396    S DIR("A" ,4)=" "
  21397   "RTN","RCD PEWLP",242 ,0)
  21398    S DIR("A" ,5)="Trace  number(s)  associate d with unp osted EFTs :"
  21399   "RTN","RCD PEWLP",243 ,0)
  21400    S LN=5,X= 0 F  S X=$ O(STR(X))  Q:'X  S LN =LN+1,DIR( "A",LN)="  "_STR(X)
  21401   "RTN","RCD PEWLP",244 ,0)
  21402    S LN=LN+1 ,DIR("A",L N)=" "
  21403   "RTN","RCD PEWLP",245 ,0)
  21404    S DIR("A" )="Press E NTER to co ntinue: "
  21405   "RTN","RCD PEWLP",246 ,0)
  21406    W !
  21407   "RTN","RCD PEWLP",247 ,0)
  21408    D ^DIR
  21409   "RTN","RCD PEWLP",248 ,0)
  21410    Q
  21411   "RTN","RCD PEWLP",249 ,0)
  21412    ;
  21413   "RTN","RCD PEWLP",250 ,0)
  21414   EXCDENY ;  PRCA*4.5*2 98
  21415   "RTN","RCD PEWLP",251 ,0)
  21416    ; access  denied mes sage for E RAs select ed off ERA  Worklist  with excep tions  
  21417   "RTN","RCD PEWLP",252 ,0)
  21418    ; PRCA*4. 5*304 - un declared p arameters  (from WL^R CDPEWL7):  RCERA and  RCEXC 
  21419   "RTN","RCD PEWLP",253 ,0)
  21420    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,RCDWLIEN ,X,Y
  21421   "RTN","RCD PEWLP",254 ,0)
  21422    S DIR(0)= "YA"
  21423   "RTN","RCD PEWLP",255 ,0)
  21424    S DIR("A" ,1)="ACCES S DENIED:   Scratchpa d creation  is not al lowed when  third par ty"
  21425   "RTN","RCD PEWLP",256 ,0)
  21426    S DIR("A" ,2)="medic al excepti ons exist.   Fix Tran smission E xceptions  first and  then Data"
  21427   "RTN","RCD PEWLP",257 ,0)
  21428    S DIR("A" ,3)="Excep tions with  the EXE E DI Lockbox  3rd Party  Exception s option w hich is"
  21429   "RTN","RCD PEWLP",258 ,0)
  21430    S DIR("A" ,4)="locat ed on the  EDI Lockbo x Main Men u."
  21431   "RTN","RCD PEWLP",259 ,0)
  21432    S DIR("A" ,5)=" "
  21433   "RTN","RCD PEWLP",260 ,0)
  21434    ;PRCA*4.5 *304 - All ow user to  fix excep tions
  21435   "RTN","RCD PEWLP",261 ,0)
  21436    S DIR("A" )="Do you  want to be gin cleari ng Excepti ons for th is ERA (Y/ N)?: "
  21437   "RTN","RCD PEWLP",262 ,0)
  21438    S DIR("B" )="Y"
  21439   "RTN","RCD PEWLP",263 ,0)
  21440    W ! D ^DI R
  21441   "RTN","RCD PEWLP",264 ,0)
  21442    ;PRCA*4.5 *304 - all ow jump to  work on E xceptions
  21443   "RTN","RCD PEWLP",265 ,0)
  21444    ; If 'yes ' to work  on excepti ons?, set  neeeded va rs., defau lt payer r ange is AL L (for now )
  21445   "RTN","RCD PEWLP",266 ,0)
  21446    I Y=1 D   S:$G(RCMBG )'="" VALM BG=RCMBG S :$G(RCDWLI EN)'="" RC ERA=RCDWLI EN S RCEXC =1 K RCMBG
  21447   "RTN","RCD PEWLP",267 ,0)
  21448    . S RCMBG =$G(VALMBG ),RCDWLIEN =RCERA D E N^RCDPEX1
  21449   "RTN","RCD PEWLP",268 ,0)
  21450    Q
  21451   "RTN","RCD PEWLP",269 ,0)
  21452    ;
  21453   "RTN","RCD PEWLP",270 ,0)
  21454   EXCWARN(ER ADA) ; prc a*4.5*298  warning ms g. if exce ption
  21455   "RTN","RCD PEWLP",271 ,0)
  21456    ; Input:    ERADA -  IEN in fil e 344.4
  21457   "RTN","RCD PEWLP",272 ,0)
  21458    ; Output:   WARNING  MESSAGE if  exception  exists on  ERA
  21459   "RTN","RCD PEWLP",273 ,0)
  21460    ;               
  21461   "RTN","RCD PEWLP",274 ,0)
  21462    Q:$$PHARM (ERADA)  ;  Ignore ph armacy ERA
  21463   "RTN","RCD PEWLP",275 ,0)
  21464    Q:$$XCEPT (ERADA)=""   ; no exc eption
  21465   "RTN","RCD PEWLP",276 ,0)
  21466    N DIR
  21467   "RTN","RCD PEWLP",277 ,0)
  21468    S DIR(0)= "EA"
  21469   "RTN","RCD PEWLP",278 ,0)
  21470    S DIR("A" ,1)="WARNI NG: Fix Tr ansmission  Exception s first an d then Dat a Exceptio ns via"
  21471   "RTN","RCD PEWLP",279 ,0)
  21472    S DIR("A" ,2)="the E XE EDI Loc kbox 3rd P arty Excep tions opti on which i s located  on the"
  21473   "RTN","RCD PEWLP",280 ,0)
  21474    S DIR("A" ,3)="EDI L ockbox Mai n Menu."
  21475   "RTN","RCD PEWLP",281 ,0)
  21476    S DIR("A" ,4)=" "
  21477   "RTN","RCD PEWLP",282 ,0)
  21478    S DIR("A" )="Press E NTER to co ntinue: "
  21479   "RTN","RCD PEWLP",283 ,0)
  21480    W !
  21481   "RTN","RCD PEWLP",284 ,0)
  21482    D ^DIR
  21483   "RTN","RCD PEWLP",285 ,0)
  21484    Q
  21485   "RTN","RCD PEWLP",286 ,0)
  21486    ;
  21487   "RTN","RCD PEWLP",287 ,0)
  21488   XCEPT(ERAD A) ; prca* 4.5*298, r eturn ERA  exception  state
  21489   "RTN","RCD PEWLP",288 ,0)
  21490    ; Input:  ERADA - IE N in file  344.4
  21491   "RTN","RCD PEWLP",289 ,0)
  21492    ; Returns : "x" or n ull, "x":  Exception  for a clai m in the E RA
  21493   "RTN","RCD PEWLP",290 ,0)
  21494    N RES
  21495   "RTN","RCD PEWLP",291 ,0)
  21496    S RES=$S( $D(^RCY(34 4.4,"AEXC" ,1,ERADA)) :"x",$D(^R CY(344.4," AEXC",2,ER ADA)):"x", $D(^RCY(34 4.4,"AEXC" ,99,ERADA) ):"ERADA", 1:"")
  21497   "RTN","RCD PEWLP",292 ,0)
  21498    Q RES
  21499   "RTN","RCD PEWLP",293 ,0)
  21500    ;
  21501   "RTN","RCD PEWLP",294 ,0)
  21502   PHARM(X1)  ; prca*4.5 *298, func tion, Phar macy, or M edical ERA ?
  21503   "RTN","RCD PEWLP",295 ,0)
  21504    ; X1 - IE N file 344 .4
  21505   "RTN","RCD PEWLP",296 ,0)
  21506    ; Returns : 1: Pharm acy ERA, 0 : Non-phar macy ERA
  21507   "RTN","RCD PEWLP",297 ,0)
  21508    Q $S($D(^ RCY(344.4, X1,1,"ECME ")):1,1:0)
  21509   "RTN","RCD PEWLP",298 ,0)
  21510    ;
  21511   "RTN","RCD PEWLP",299 ,0)
  21512   GETPHARM(P RCAIEN,RCA RRY) ;prca *4.5*298 r eturn phar macy data  to show on  EEOB item s in scrat chpad
  21513   "RTN","RCD PEWLP",300 ,0)
  21514    ; Input:  PRCAIEN -  IEN file 4 30
  21515   "RTN","RCD PEWLP",301 ,0)
  21516    ; Output:  RCARRY  -  holds pha rmacy data  
  21517   "RTN","RCD PEWLP",302 ,0)
  21518    ; IA 6033  - read ac cess file  362.4
  21519   "RTN","RCD PEWLP",303 ,0)
  21520    ; ICR 187 8 - EN^PSO ORDER call
  21521   "RTN","RCD PEWLP",304 ,0)
  21522    N RC0,RCD FN,RXDATA, RXFILL,RXI EN
  21523   "RTN","RCD PEWLP",305 ,0)
  21524    K RCARRY
  21525   "RTN","RCD PEWLP",306 ,0)
  21526    Q:PRCAIEN =""
  21527   "RTN","RCD PEWLP",307 ,0)
  21528    S RCDFN=$ P(^PRCA(43 0,PRCAIEN, 0),U,7)
  21529   "RTN","RCD PEWLP",308 ,0)
  21530    S RC0=+$O (^IBA(362. 4,"C",PRCA IEN,0)) Q: RC0=0
  21531   "RTN","RCD PEWLP",309 ,0)
  21532    S RXDATA= $G(^IBA(36 2.4,RC0,0) )
  21533   "RTN","RCD PEWLP",310 ,0)
  21534    S RCARRY( "DOS")=$$F MTE^XLFDT( $P(RXDATA, U,3),"2Z")
  21535   "RTN","RCD PEWLP",311 ,0)
  21536    S RCARRY( "FILL")=+$ P(RXDATA,U ,10)  ; Rx  fill#
  21537   "RTN","RCD PEWLP",312 ,0)
  21538    S RXIEN=+ $P(RXDATA, U,5)  ; Rx  IEN in fi le 52
  21539   "RTN","RCD PEWLP",313 ,0)
  21540    D EN^PSOO RDER(RCDFN ,RXIEN)
  21541   "RTN","RCD PEWLP",314 ,0)
  21542    S RCARRY( "RX")=$P(^ TMP("PSOR" ,$J,RXIEN, 0),U,5)
  21543   "RTN","RCD PEWLP",315 ,0)
  21544    I RCARRY( "FILL")=0  D
  21545   "RTN","RCD PEWLP",316 ,0)
  21546    . S RCARR Y("RELEASE D STATUS") =$S($P(^TM P("PSOR",$ J,RXIEN,0) ,U,13)]"": "Released" ,1:"Not Re leased")    ; determi ne release  status fr om Rx on t he first f ill (no re fills)
  21547   "RTN","RCD PEWLP",317 ,0)
  21548    I RCARRY( "FILL")>0  D
  21549   "RTN","RCD PEWLP",318 ,0)
  21550    . S RCARR Y("RELEASE D STATUS") =$S($P($G( ^TMP("PSOR ",$J,RXIEN ,"REF",RCA RRY("FILL" ),0)),U,8) ]"":"Relea sed",1:"No t Released ")  ; ; de termine re lease stat us from Rx  refill #  ;PRCA319 a dd $G()
  21551   "RTN","RCD PEWLP",319 ,0)
  21552    Q
  21553   "RTN","RCD PEWLP",320 ,0)
  21554    ;
  21555   "RTN","RCD PEWLP",321 ,0)
  21556   CV ; Chang e View act ion for ER A Worklist
  21557   "RTN","RCD PEWLP",322 ,0)
  21558    D FULL^VA LM1
  21559   "RTN","RCD PEWLP",323 ,0)
  21560    D PARAMS^ RCDPEWL0(" CV")
  21561   "RTN","RCD PEWLP",324 ,0)
  21562    D HDR^RCD PEWL7,INIT ^RCDPEWL7
  21563   "RTN","RCD PEWLP",325 ,0)
  21564    S VALMBCK ="R",VALMB G=1
  21565   "RTN","RCD PEWLP",326 ,0)
  21566    Q
  21567   "RTN","RCD PEWLP",327 ,0)
  21568    ;
  21569   "RTN","RCD PEWLP",328 ,0)
  21570   NOEDIT ; n o edit all owed, ERA  designated  for auto- posting
  21571   "RTN","RCD PEWLP",329 ,0)
  21572    N DIR
  21573   "RTN","RCD PEWLP",330 ,0)
  21574    S DIR(0)= "EA",DIR(" A",1)="Thi s action i s not avai lable for  Auto-Poste d ERAs."
  21575   "RTN","RCD PEWLP",331 ,0)
  21576    S DIR("A" )="Press E NTER to co ntinue: "
  21577   "RTN","RCD PEWLP",332 ,0)
  21578    W ! D ^DI R W !
  21579   "RTN","RCD PEWLP",333 ,0)
  21580    Q
  21581   "RTN","RCD PEWLP",334 ,0)
  21582    ;
  21583   "RTN","RCD PEWLP",335 ,0)
  21584   VR(ERADA)  ; handle a uto-posted  ERAs, Loo k at Recei pt protoco l for stan dard Workl ist
  21585   "RTN","RCD PEWLP",336 ,0)
  21586    ; Input:  ERADA - IE N from fil e 344.49 ( and 344.4)
  21587   "RTN","RCD PEWLP",337 ,0)
  21588    N RCDA,RC Z,RCZ0,EEO BREC
  21589   "RTN","RCD PEWLP",338 ,0)
  21590    D SEL^RCD PEWL(.RCDA )  ; Selec t EEOB off  scratchpa d
  21591   "RTN","RCD PEWLP",339 ,0)
  21592    S RCZ=+$O (RCDA(0)), RCZ=+$G(RC DA(RCZ))
  21593   "RTN","RCD PEWLP",340 ,0)
  21594    Q:'RCZ
  21595   "RTN","RCD PEWLP",341 ,0)
  21596    S RCZ0=$G (^RCY(344. 49,ERADA,1 ,RCZ,0))
  21597   "RTN","RCD PEWLP",342 ,0)
  21598    S EEOBREC =$P($G(^RC Y(344.4,ER ADA,1,+$P( RCZ0,U,9), 4)),U,3)
  21599   "RTN","RCD PEWLP",343 ,0)
  21600    I EEOBREC ']"" D NOV IEW Q 
  21601   "RTN","RCD PEWLP",344 ,0)
  21602    D EN^VALM ("RCDPE AU TO EOB REC EIPT PREVI EW")
  21603   "RTN","RCD PEWLP",345 ,0)
  21604    Q
  21605   "RTN","RCD PEWLP",346 ,0)
  21606    ;
  21607   "RTN","RCD PEWLP",347 ,0)
  21608   NOVIEW ; s elected EE OB cannot  be viewed  if no rece ipt number
  21609   "RTN","RCD PEWLP",348 ,0)
  21610    N DIR
  21611   "RTN","RCD PEWLP",349 ,0)
  21612    S DIR(0)= "EA"
  21613   "RTN","RCD PEWLP",350 ,0)
  21614    S DIR("A" ,1)="THIS  ACTION IS  NOT AVAILA BLE SINCE  THE EEOB H AS NOT BEE N AUTO-POS TED."
  21615   "RTN","RCD PEWLP",351 ,0)
  21616    S DIR("A" )="Press E NTER to co ntinue: "
  21617   "RTN","RCD PEWLP",352 ,0)
  21618    W ! D ^DI R W !
  21619   "RTN","RCD PEWLP",353 ,0)
  21620    Q
  21621   "RTN","RCD PEWLP",354 ,0)
  21622    ;
  21623   "RTN","RCD PEWLP",355 ,0)
  21624   INIT(ERADA ,EEOBREC)  ; List Tem plate - RC DPE AUTO E OB RECEIPT  PREVIEW e ntry point
  21625   "RTN","RCD PEWLP",356 ,0)
  21626    ; Display  EEOBs tha t have bee n posted ( receipt ex ists)
  21627   "RTN","RCD PEWLP",357 ,0)
  21628    ; Input:
  21629   "RTN","RCD PEWLP",358 ,0)
  21630    ; ERADA -  IEN file  344.49 (an d 344.4)
  21631   "RTN","RCD PEWLP",359 ,0)
  21632    ; EEOBREC  - Selecte d EEOBs re ceipt
  21633   "RTN","RCD PEWLP",360 ,0)
  21634    ; Output:   ^TMP("RC DPE_AP_EOB _PREVIEW", $J)
  21635   "RTN","RCD PEWLP",361 ,0)
  21636    N RCPT,RC Z,Z,Z0,Z1, Z2,SEQ
  21637   "RTN","RCD PEWLP",362 ,0)
  21638    K ^TMP("R CDPE_AP_EO B_PREVIEW" ,$J)
  21639   "RTN","RCD PEWLP",363 ,0)
  21640    S VALMCNT =0,VALMBG= 1
  21641   "RTN","RCD PEWLP",364 ,0)
  21642    S SEQ(344 .491)=0 F   S SEQ(344 .491)=$O(^ RCY(344.49 ,ERADA,1,S EQ(344.491 ))) Q:'SEQ (344.491)   D
  21643   "RTN","RCD PEWLP",365 ,0)
  21644    . S SEQ(3 44.491,0)= $G(^RCY(34 4.49,ERADA ,1,SEQ(344 .491),0))
  21645   "RTN","RCD PEWLP",366 ,0)
  21646    . I $P(SE Q(344.491, 0),U)\1=+S EQ(344.491 ,0) S SEQ( "claim#")= $P(SEQ(344 .491,0),U, 2)
  21647   "RTN","RCD PEWLP",367 ,0)
  21648    . S RCPT= +$P($G(^RC Y(344.4,ER ADA,1,+$P( SEQ(344.49 1,0),U,9), 4)),U,3),R CPT(RCPT)= ""  ; rece ipt array
  21649   "RTN","RCD PEWLP",368 ,0)
  21650    . I $P($P (SEQ(344.4 91,0),U)," .",2),$D(R CPT(EEOBRE C)) D   ;  if the EEO B has same  receipt#  as selecte d EEOB it  can be on  the previe w screen
  21651   "RTN","RCD PEWLP",369 ,0)
  21652    ..  S:$P( SEQ(344.49 1,0),U,2)= "" $P(SEQ( 344.491,0) ,U,2)=SEQ( "claim#")
  21653   "RTN","RCD PEWLP",370 ,0)
  21654    ..  ;RCZ= 0:zero pay ments, -1: negative b al., 1:lin es for rcp t., 2:othe r lines
  21655   "RTN","RCD PEWLP",371 ,0)
  21656    ..  S RCZ =$S(+$P(SE Q(344.491, 0),U,6)=0: 0,+$P(SEQ( 344.491,0) ,U,6)<0:-1 ,$P(SEQ(34 4.491,0),U ,7):1,1:2)
  21657   "RTN","RCD PEWLP",372 ,0)
  21658    ..  S RCZ (RCZ,SEQ(3 44.491))=S EQ(344.491 ,0)
  21659   "RTN","RCD PEWLP",373 ,0)
  21660    ..  K RCP T
  21661   "RTN","RCD PEWLP",374 ,0)
  21662    ..  S SEQ (344.4911) =0  F  S S EQ(344.491 1)=$O(^RCY (344.49,ER ADA,1,SEQ( 344.491),1 ,SEQ(344.4 911))) Q:' SEQ(344.49 11)  D
  21663   "RTN","RCD PEWLP",375 ,0)
  21664    ...   S S EQ(344.491 1,0)=$G(^R CY(344.49, ERADA,1,SE Q(344.491) ,1,SEQ(344 .4911),0))
  21665   "RTN","RCD PEWLP",376 ,0)
  21666    ...   I $ P(SEQ(344. 4911,0),U, 5)=1 D  ;( #.05) BACK GROUND ACT ION [5S] -  '1' FOR D ECREASE AD JUSTMENT; 
  21667   "RTN","RCD PEWLP",377 ,0)
  21668    ....    S  RCZ(RCZ,S EQ(344.491 ),"ADJ",SE Q(344.4911 ))="Dec ad j $"_$J(0- $P(SEQ(344 .4911,0),U ,3),"",2)_ " pending  - "
  21669   "RTN","RCD PEWLP",378 ,0)
  21670    ....    S  RCZ(RCZ,S EQ(344.491 ),"ADJ",SE Q(344.4911 ),1)=$J("" ,4)_$P(SEQ (344.4911, 0),U,9)
  21671   "RTN","RCD PEWLP",379 ,0)
  21672    ;
  21673   "RTN","RCD PEWLP",380 ,0)
  21674    F RCZ=1,2 ,0,-1 D:$D (RCZ(RCZ))
  21675   "RTN","RCD PEWLP",381 ,0)
  21676    . I RCZ=1  D SET("PA YMENTS (LI NES FOR RE CEIPT):")
  21677   "RTN","RCD PEWLP",382 ,0)
  21678    . I RCZ=0 ,VALMCNT>0  D SET(" " ),SET("ZER O DOLLAR P AYMENTS:")
  21679   "RTN","RCD PEWLP",383 ,0)
  21680    . I RCZ=- 1,VALMCNT> 0 D SET("  "),SET("LI NES WITH N EGATIVE BA LANCES STI LL NEEDING  TO BE DIS TRIBUTED:" )
  21681   "RTN","RCD PEWLP",384 ,0)
  21682    . S Z=0 F   S Z=$O(R CZ(RCZ,Z))  Q:'Z  D
  21683   "RTN","RCD PEWLP",385 ,0)
  21684    ..  S Z0= RCZ(RCZ,Z) ,X=""
  21685   "RTN","RCD PEWLP",386 ,0)
  21686    ..  S X=$ $SETFLD^VA LM1($P(Z0, U),X,"LINE  #")
  21687   "RTN","RCD PEWLP",387 ,0)
  21688    ..  S X=$ $SETFLD^VA LM1($S($P( Z0,U,7):$$ BN1^PRCAFN ($P(Z0,U,7 )),1:$S(RC Z=0:"",1:" [SUSPENSE] ")_$S($P(Z 0,U,2)["** ADJ"&'$P($ P(Z0,U,2), "ADJ",2):" TOTALS MIS MATCH ADJ" ,1:$P(Z0,U ,2))),X,"A CCOUNT")
  21689   "RTN","RCD PEWLP",388 ,0)
  21690    ..  S X=$ $SETFLD^VA LM1($J(+$P (Z0,U,6)," ",2),X,"AM OUNT")
  21691   "RTN","RCD PEWLP",389 ,0)
  21692    ..  D SET (X)
  21693   "RTN","RCD PEWLP",390 ,0)
  21694    ..  S Z1= 0 F  S Z1= $O(RCZ(RCZ ,Z,"ADJ",Z 1)) Q:'Z1   D
  21695   "RTN","RCD PEWLP",391 ,0)
  21696    ...   D S ET($J("",1 2)_$G(RCZ( RCZ,Z,"ADJ ",Z1)))
  21697   "RTN","RCD PEWLP",392 ,0)
  21698    ...   S Z 2=0 F  S Z 2=$O(RCZ(R CZ,Z,"ADJ" ,Z1,Z2)) Q :'Z2  D SE T($J("",12 )_$G(RCZ(R CZ,Z,"ADJ" ,Z1,Z2)))
  21699   "RTN","RCD PEWLP",393 ,0)
  21700    Q
  21701   "RTN","RCD PEWLP",394 ,0)
  21702    ;
  21703   "RTN","RCD PEWLP",395 ,0)
  21704   SET(X) ;
  21705   "RTN","RCD PEWLP",396 ,0)
  21706    S VALMCNT =VALMCNT+1 ,^TMP("RCD PE_AP_EOB_ PREVIEW",$ J,VALMCNT, 0)=X
  21707   "RTN","RCD PEWLP",397 ,0)
  21708    Q
  21709   "RTN","RCD PEWLP",398 ,0)
  21710    ;
  21711   "RTN","RCD PEWLP",399 ,0)
  21712   HDR ;
  21713   "RTN","RCD PEWLP",400 ,0)
  21714    D HDR^RCD PEWL Q
  21715   "RTN","RCD PEWLP",401 ,0)
  21716    ;
  21717   "RTN","RCD PEWLP",402 ,0)
  21718   FNL ;
  21719   "RTN","RCD PEWLP",403 ,0)
  21720    K ^TMP("R CDPE_AP_EO B_PREVIEW" ,$J) Q
  21721   "RTN","RCD PEWLP",404 ,0)
  21722    ;
  21723   "RTN","RCD PEWLZ")
  21724   0^31^B2390 6831
  21725   "RTN","RCD PEWLZ",1,0 )
  21726   RCDPEWLZ ; ALB/PJH-Bl ock Auto-d ecrease pr otocol ;09  Feb 2018
  21727   "RTN","RCD PEWLZ",2,0 )
  21728    ;;4.5;Acc ounts Rece ivable;**3 26,332**;M ar 20, 199 5;Build 34
  21729   "RTN","RCD PEWLZ",3,0 )
  21730    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  21731   "RTN","RCD PEWLZ",4,0 )
  21732    Q
  21733   "RTN","RCD PEWLZ",5,0 )
  21734    ;
  21735   "RTN","RCD PEWLZ",6,0 )
  21736   BLOCK(RCER A) ;  Stop /Allow Aut o Decrease  of zero b alance den ials
  21737   "RTN","RCD PEWLZ",7,0 )
  21738    ;
  21739   "RTN","RCD PEWLZ",8,0 )
  21740    ; Input -  RCERA - I EN of ERA  in #344.4
  21741   "RTN","RCD PEWLZ",9,0 )
  21742    ;
  21743   "RTN","RCD PEWLZ",10, 0)
  21744    ; Check t hat the ER A has auto -decrease  CARCs whic h are not  decreased
  21745   "RTN","RCD PEWLZ",11, 0)
  21746    N RCARRAY
  21747   "RTN","RCD PEWLZ",12, 0)
  21748    D AUTO(RC ERA,.RCARR AY)
  21749   "RTN","RCD PEWLZ",13, 0)
  21750    ;
  21751   "RTN","RCD PEWLZ",14, 0)
  21752    D FULL^VA LM1
  21753   "RTN","RCD PEWLZ",15, 0)
  21754    S VALMBCK ="R"
  21755   "RTN","RCD PEWLZ",16, 0)
  21756    ;
  21757   "RTN","RCD PEWLZ",17, 0)
  21758    I 'RCARRA Y D  G QUI T
  21759   "RTN","RCD PEWLZ",18, 0)
  21760    .W !!,"Th is option  is only va lid if an  ERA has au to-decreas e CARCs."
  21761   "RTN","RCD PEWLZ",19, 0)
  21762    ;
  21763   "RTN","RCD PEWLZ",20, 0)
  21764    I RCARRAY ("D") D  G  QUIT
  21765   "RTN","RCD PEWLZ",21, 0)
  21766    .W !!,"Th is option  is not val id, the ER A has alre ady been a uto-decrea sed."
  21767   "RTN","RCD PEWLZ",22, 0)
  21768    ;
  21769   "RTN","RCD PEWLZ",23, 0)
  21770    N RCSTA,X
  21771   "RTN","RCD PEWLZ",24, 0)
  21772    S RCSTA=$ $GET1^DIQ( 344.4,RCER A_",",.19, "I")
  21773   "RTN","RCD PEWLZ",25, 0)
  21774    ;
  21775   "RTN","RCD PEWLZ",26, 0)
  21776    ;
  21777   "RTN","RCD PEWLZ",27, 0)
  21778    W !!,"Thi s option w ill "
  21779   "RTN","RCD PEWLZ",28, 0)
  21780    W $S(RCST A:"ALLOW t he nightly  process t o auto-dec rease",1:" STOP the n ightly pro cess from  auto-decre asing")
  21781   "RTN","RCD PEWLZ",29, 0)
  21782    W !," the  CARCs on  this ERA." ,!
  21783   "RTN","RCD PEWLZ",30, 0)
  21784    ;
  21785   "RTN","RCD PEWLZ",31, 0)
  21786    I $$ASKST AT(RCSTA)' =1 Q
  21787   "RTN","RCD PEWLZ",32, 0)
  21788    ;
  21789   "RTN","RCD PEWLZ",33, 0)
  21790    ; Update  ERA
  21791   "RTN","RCD PEWLZ",34, 0)
  21792    D UPD(RCE RA,RCSTA)
  21793   "RTN","RCD PEWLZ",35, 0)
  21794    ;
  21795   "RTN","RCD PEWLZ",36, 0)
  21796    W !,"...  CARCs on t his ERA wi ll "_$S(RC STA:"",1:" NOT ")_"be  auto-decr eased ..."
  21797   "RTN","RCD PEWLZ",37, 0)
  21798    ;
  21799   "RTN","RCD PEWLZ",38, 0)
  21800   QUIT ;  pa use and re build the  header
  21801   "RTN","RCD PEWLZ",39, 0)
  21802    W !!,"pre ss RETURN  to continu e: "
  21803   "RTN","RCD PEWLZ",40, 0)
  21804    R X:DTIME
  21805   "RTN","RCD PEWLZ",41, 0)
  21806    ;
  21807   "RTN","RCD PEWLZ",42, 0)
  21808    N RCARC
  21809   "RTN","RCD PEWLZ",43, 0)
  21810    S RCARC=$ $WLH^RCDPE WLZ(+RCSCR )
  21811   "RTN","RCD PEWLZ",44, 0)
  21812    S:RCARC]" " VALMHDR( 4)=RCARC
  21813   "RTN","RCD PEWLZ",45, 0)
  21814    Q
  21815   "RTN","RCD PEWLZ",46, 0)
  21816    ;
  21817   "RTN","RCD PEWLZ",47, 0)
  21818   ASKSTAT(RC STA) ;  as k if its o kay to blo ck to unbl ock from a uto-decrea se
  21819   "RTN","RCD PEWLZ",48, 0)
  21820    ;  1 is y es, otherw ise no
  21821   "RTN","RCD PEWLZ",49, 0)
  21822    N DIR,DIQ 2,DTOUT,DU OUT,X,Y
  21823   "RTN","RCD PEWLZ",50, 0)
  21824    S DIR(0)= "YO",DIR(" B")="Y"
  21825   "RTN","RCD PEWLZ",51, 0)
  21826    S DIR("A" )="Do you  want to "_ $S(RCSTA:" ALLOW",1:" STOP")_" a uto-decrea se of this  ERA"
  21827   "RTN","RCD PEWLZ",52, 0)
  21828    D ^DIR
  21829   "RTN","RCD PEWLZ",53, 0)
  21830    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  21831   "RTN","RCD PEWLZ",54, 0)
  21832    Q Y
  21833   "RTN","RCD PEWLZ",55, 0)
  21834    ;
  21835   "RTN","RCD PEWLZ",56, 0)
  21836   AUTO(RCERA ,RCARRAY)  ; Search E RA for Aut o-Decrease  CARCs 
  21837   "RTN","RCD PEWLZ",57, 0)
  21838    ; INPUT -   RCERA =  ERA number /IEN
  21839   "RTN","RCD PEWLZ",58, 0)
  21840    ;           RCARRAY  = return a rray refer ence
  21841   "RTN","RCD PEWLZ",59, 0)
  21842    ; OUTPUT  - RCARRAY  = list of  ERA lines  and auto-d ecrease CA RC/amounts  for each  line
  21843   "RTN","RCD PEWLZ",60, 0)
  21844    ;
  21845   "RTN","RCD PEWLZ",61, 0)
  21846    ;           RCARRAY=
  21847   "RTN","RCD PEWLZ",62, 0)
  21848    ;           RCARRAY( 1)="5.71;2 2;^10.00;2 3;"  - lis t of decre ase amount s for each  auto-decr ease CARC
  21849   "RTN","RCD PEWLZ",63, 0)
  21850    ;           RCARRAY( 1,"D")=1    - indicat es line is  decreased  already
  21851   "RTN","RCD PEWLZ",64, 0)
  21852    ;           RCARRAY( 1,"B")=1    - indicat es line is /was block ed
  21853   "RTN","RCD PEWLZ",65, 0)
  21854    ;
  21855   "RTN","RCD PEWLZ",66, 0)
  21856    N EOBIEN, PAYID,PAYN AM,RC3446, RCARC,RCBL K,RCDAY,RC PARM,RCRCV D,RCSUB,RC RTYPE,RCZE RO
  21857   "RTN","RCD PEWLZ",67, 0)
  21858    K RCARRAY
  21859   "RTN","RCD PEWLZ",68, 0)
  21860    S RCARRAY =0,RCARRAY ("D")=0
  21861   "RTN","RCD PEWLZ",69, 0)
  21862    ; Ignore  ERA if tot al paid is  not zero
  21863   "RTN","RCD PEWLZ",70, 0)
  21864    Q:+$$GET1 ^DIQ(344.4 ,RCERA_"," ,.05)
  21865   "RTN","RCD PEWLZ",71, 0)
  21866    ; Ignore  ERA if rem oved from  worklist
  21867   "RTN","RCD PEWLZ",72, 0)
  21868    Q:+$$GET1 ^DIQ(344.4 ,RCERA_"," ,.16,"I")
  21869   "RTN","RCD PEWLZ",73, 0)
  21870    ; Calcula te process  date by s ubtracting  DENIAL de crease day s from tod ay's date
  21871   "RTN","RCD PEWLZ",74, 0)
  21872    S RCDAY=$ $FMADD^XLF DT(DT\1,-$ $GET1^DIQ( 344.61,"1, ",.12))
  21873   "RTN","RCD PEWLZ",75, 0)
  21874    ; Compare  to ERA re ceived dat e
  21875   "RTN","RCD PEWLZ",76, 0)
  21876    S RCRCVD= $$GET1^DIQ (344.4,RCE RA_",",.07 ,"I")
  21877   "RTN","RCD PEWLZ",77, 0)
  21878    ; If not  already de creased th en check t hat auto-d ecrease da te is not  already pa st
  21879   "RTN","RCD PEWLZ",78, 0)
  21880    I $$GET1^ DIQ(344.4, RCERA_",", 4.03,"I")= "",RCRCVD\ 1<RCDAY Q
  21881   "RTN","RCD PEWLZ",79, 0)
  21882    ; Ignore  ERA if not  payment t ype of NON
  21883   "RTN","RCD PEWLZ",80, 0)
  21884    I $$GET1^ DIQ(344.4, RCERA_",", .15)'="NON "
  21885   "RTN","RCD PEWLZ",81, 0)
  21886    ; Ignore  ERA if it  has PLBs
  21887   "RTN","RCD PEWLZ",82, 0)
  21888    Q:$D(^TMP ($J,"RCDPE WLA","ERA  LEVEL ADJU STMENT EXI STS"))
  21889   "RTN","RCD PEWLZ",83, 0)
  21890    ; Quit if  ERA is fo r Pharmacy
  21891   "RTN","RCD PEWLZ",84, 0)
  21892    S RCRTYPE =$$PHARM^R CDPEAP1(RC ERA)
  21893   "RTN","RCD PEWLZ",85, 0)
  21894    Q:RCRTYPE
  21895   "RTN","RCD PEWLZ",86, 0)
  21896    ; Check p ayer exclu sion file  for this E RA's payer
  21897   "RTN","RCD PEWLZ",87, 0)
  21898    S PAYID=$ P($G(^RCY( 344.4,RCER A,0)),U,3)
  21899   "RTN","RCD PEWLZ",88, 0)
  21900    S PAYNAM= $P($G(^RCY (344.4,RCE RA,0)),U,6 )
  21901   "RTN","RCD PEWLZ",89, 0)
  21902    I PAYID'= "",PAYNAM' ="" D
  21903   "RTN","RCD PEWLZ",90, 0)
  21904    . S RCPAR M=$O(^RCY( 344.6,"CPI D",PAYNAM, PAYID,""))
  21905   "RTN","RCD PEWLZ",91, 0)
  21906    . S:RCPAR M'="" RC34 46=$G(^RCY (344.6,RCP ARM,0))
  21907   "RTN","RCD PEWLZ",92, 0)
  21908    ; Ignore  ERA if EXC LUDE MED C LAIMS POST ING  (#.06 ) or EXCLU DE MED CLA IMS DECREA SE (#.07)  fields set  to 'yes'
  21909   "RTN","RCD PEWLZ",93, 0)
  21910    I $G(RC34 46)'="" Q: $P(RC3446, U,6)=1  Q: $P(RC3446, U,7)=1
  21911   "RTN","RCD PEWLZ",94, 0)
  21912    ; Scan ER A for EOB  - do NOT u se scratch pad
  21913   "RTN","RCD PEWLZ",95, 0)
  21914    S RCSUB=0 ,RCZERO=1
  21915   "RTN","RCD PEWLZ",96, 0)
  21916    F  S RCSU B=$O(^RCY( 344.4,RCER A,1,RCSUB) ) Q:'RCSUB   D
  21917   "RTN","RCD PEWLZ",97, 0)
  21918    .; Get IE N of EOB
  21919   "RTN","RCD PEWLZ",98, 0)
  21920    .S EOBIEN =$$GET1^DI Q(344.41,R CSUB_","_R CERA,.02," I")
  21921   "RTN","RCD PEWLZ",99, 0)
  21922    .Q:'EOBIE N
  21923   "RTN","RCD PEWLZ",100 ,0)
  21924    .; Get CA RCS
  21925   "RTN","RCD PEWLZ",101 ,0)
  21926    .S RCARC= $$CARCLMT^ RCDPEAD(EO BIEN,RCZER O)
  21927   "RTN","RCD PEWLZ",102 ,0)
  21928    .; No CAR Cs on EOB  were eligi ble for au to-decreas e
  21929   "RTN","RCD PEWLZ",103 ,0)
  21930    .Q:$L(RCA RC)=0
  21931   "RTN","RCD PEWLZ",104 ,0)
  21932    .; Save C ARCs again s line num ber
  21933   "RTN","RCD PEWLZ",105 ,0)
  21934    .S RCARRA Y(RCSUB)=R CARC
  21935   "RTN","RCD PEWLZ",106 ,0)
  21936    .; CARCs  found indi cator
  21937   "RTN","RCD PEWLZ",107 ,0)
  21938    .S RCARRA Y=1
  21939   "RTN","RCD PEWLZ",108 ,0)
  21940    .; Determ ine if lin e is alrea dy auto-de creased
  21941   "RTN","RCD PEWLZ",109 ,0)
  21942    .S:$$GET1 ^DIQ(344.4 1,RCSUB_", "_RCERA_", ",10,"I")] "" RCARRAY ("D")=1
  21943   "RTN","RCD PEWLZ",110 ,0)
  21944    Q
  21945   "RTN","RCD PEWLZ",111 ,0)
  21946    ;
  21947   "RTN","RCD PEWLZ",112 ,0)
  21948   UPD(RCERA, RCSTA) ; U pdate AUTO -DECREASE  BLOCKED st atus of an  ERA
  21949   "RTN","RCD PEWLZ",113 ,0)
  21950    N DA,DIE, DR
  21951   "RTN","RCD PEWLZ",114 ,0)
  21952    S DA=RCER A
  21953   "RTN","RCD PEWLZ",115 ,0)
  21954    S DIE="^R CY(344.4," ,DR=".19// /"_$S(RCST A:0,1:1) D  ^DIE
  21955   "RTN","RCD PEWLZ",116 ,0)
  21956    Q
  21957   "RTN","RCD PEWLZ",117 ,0)
  21958    ;
  21959   "RTN","RCD PEWLZ",118 ,0)
  21960   WLF(RCERA)  ; Return  auto-decre ase flag -  EP EXTRAC T^RCDPEWL7
  21961   "RTN","RCD PEWLZ",119 ,0)
  21962    ; INPUT   - RCERA =  IEN of ERA  in #344.4
  21963   "RTN","RCD PEWLZ",120 ,0)
  21964    ; OUTPUT  - 'c' or n ull
  21965   "RTN","RCD PEWLZ",121 ,0)
  21966    N RCARRAY
  21967   "RTN","RCD PEWLZ",122 ,0)
  21968    ; Check f or CARCs
  21969   "RTN","RCD PEWLZ",123 ,0)
  21970    D AUTO(RC ERA,.RCARR AY)
  21971   "RTN","RCD PEWLZ",124 ,0)
  21972    ; Return  result
  21973   "RTN","RCD PEWLZ",125 ,0)
  21974    Q $S(RCAR RAY:"c",1: "")
  21975   "RTN","RCD PEWLZ",126 ,0)
  21976    ;
  21977   "RTN","RCD PEWLZ",127 ,0)
  21978   WLH(RCERA)  ; Auto-de crease sta tus for ER A - EP HDR ^RCDPEWL
  21979   "RTN","RCD PEWLZ",128 ,0)
  21980    ; INPUT   - RCERA =  IEN of ERA  in #344.4
  21981   "RTN","RCD PEWLZ",129 ,0)
  21982    ; OUTPUT  - RCTXT =  display te xt
  21983   "RTN","RCD PEWLZ",130 ,0)
  21984    N RCARRAY
  21985   "RTN","RCD PEWLZ",131 ,0)
  21986    ; Check f or CARCs
  21987   "RTN","RCD PEWLZ",132 ,0)
  21988    D AUTO(RC ERA,.RCARR AY)
  21989   "RTN","RCD PEWLZ",133 ,0)
  21990    ; If none  return nu ll
  21991   "RTN","RCD PEWLZ",134 ,0)
  21992    I 'RCARRA Y Q ""
  21993   "RTN","RCD PEWLZ",135 ,0)
  21994    ; Check i f ERA is a uto-decrea se blocked
  21995   "RTN","RCD PEWLZ",136 ,0)
  21996    Q:$$GET1^ DIQ(344.4, RCERA_",", .19,"I") " Auto-Decre ase CARCS  are stoppe d from aut o-decrease "
  21997   "RTN","RCD PEWLZ",137 ,0)
  21998    ; Check i f already  auto-decre ased
  21999   "RTN","RCD PEWLZ",138 ,0)
  22000    Q:RCARRAY ("D") "ERA  has proce ssed Auto- Decrease C ARCS"
  22001   "RTN","RCD PEWLZ",139 ,0)
  22002    ; Else
  22003   "RTN","RCD PEWLZ",140 ,0)
  22004    Q "ERA ha s unproces sed Auto-D ecrease CA RCS"
  22005   "RTN","RCD PEWLZ",141 ,0)
  22006    ;
  22007   "RTN","RCD PEWLZ",142 ,0)
  22008   WLL(RCERA, RCLINE) ;  Auto-decre ase status  for ERA l ine - EP -  RCDPEWL0
  22009   "RTN","RCD PEWLZ",143 ,0)
  22010    ; INPUT   - RCERA =  IEN of ERA  in #344.4
  22011   "RTN","RCD PEWLZ",144 ,0)
  22012    ;           RCLINE =  ERA line  number
  22013   "RTN","RCD PEWLZ",145 ,0)
  22014    ; OUTPUT  - RCTXT =  display te xt
  22015   "RTN","RCD PEWLZ",146 ,0)
  22016    N I,RCARC ,RCARRAY,R CTOT
  22017   "RTN","RCD PEWLZ",147 ,0)
  22018    ; Check f or CARCs o n ERA
  22019   "RTN","RCD PEWLZ",148 ,0)
  22020    D AUTO(RC ERA,.RCARR AY)
  22021   "RTN","RCD PEWLZ",149 ,0)
  22022    ; Check f or CARCs o n line
  22023   "RTN","RCD PEWLZ",150 ,0)
  22024    Q:'$D(RCA RRAY(RCLIN E)) ""
  22025   "RTN","RCD PEWLZ",151 ,0)
  22026    ; Total l ine CARCS
  22027   "RTN","RCD PEWLZ",152 ,0)
  22028    S RCTOT=0
  22029   "RTN","RCD PEWLZ",153 ,0)
  22030    F I=1:1 S  RCARC=$P( RCARRAY(RC LINE),U,I)  Q:RCARC=" "  S RCTOT =RCTOT+$P( RCARC,";")
  22031   "RTN","RCD PEWLZ",154 ,0)
  22032    Q $S(RCTO T:"Auto-de crease CAR C total: $ "_RCTOT,1: "")
  22033   "RTN","RCD PEWLZ",155 ,0)
  22034    ;
  22035   "RTN","RCD PEWLZ",156 ,0)
  22036   SCRPAD(RCE RA) ;Build  Scratchpa d entry in  #344.49 f or the ERA  - EP REJ^ RCDPEAD
  22037   "RTN","RCD PEWLZ",157 ,0)
  22038    ;
  22039   "RTN","RCD PEWLZ",158 ,0)
  22040    ; Input -  RCERA - I EN for #34 4.4
  22041   "RTN","RCD PEWLZ",159 ,0)
  22042    ;
  22043   "RTN","RCD PEWLZ",160 ,0)
  22044    ; Output  - RCSCR =  Scratchpad  IEN (Succ ess) or 0  (Fail)
  22045   "RTN","RCD PEWLZ",161 ,0)
  22046    ;
  22047   "RTN","RCD PEWLZ",162 ,0)
  22048    N RC0,RC5 ,RCSCR,RCD AT,X
  22049   "RTN","RCD PEWLZ",163 ,0)
  22050    S RC0=$G( ^RCY(344.4 ,RCERA,0)) ,RC5=$G(^R CY(344.4,R CERA,5))
  22051   "RTN","RCD PEWLZ",164 ,0)
  22052    ;Ignore i s this ERA  already h as a recei pt
  22053   "RTN","RCD PEWLZ",165 ,0)
  22054    I +$P(RC0 ,U,8) Q 0
  22055   "RTN","RCD PEWLZ",166 ,0)
  22056    ;Denial E RA must be  expected  payment ty pe NON 
  22057   "RTN","RCD PEWLZ",167 ,0)
  22058    I $P(RC0, U,15)'="NO N" Q 0
  22059   "RTN","RCD PEWLZ",168 ,0)
  22060    ;Scratchp ad already  exists
  22061   "RTN","RCD PEWLZ",169 ,0)
  22062    S RCSCR=+ $O(^RCY(34 4.49,"B",R CERA,0)) I  RCSCR G S CRPADX
  22063   "RTN","RCD PEWLZ",170 ,0)
  22064    ;Create n ew Scratch pad
  22065   "RTN","RCD PEWLZ",171 ,0)
  22066    S RCSCR=+ $$ADDREC^R CDPEWL(RCE RA,.RCDAT)  I 'RCSCR  Q 0
  22067   "RTN","RCD PEWLZ",172 ,0)
  22068    ;Add all  the ERA li nes to the  Scratchpa d entry
  22069   "RTN","RCD PEWLZ",173 ,0)
  22070    D ADDLINE S^RCDPEWLA (RCSCR)
  22071   "RTN","RCD PEWLZ",174 ,0)
  22072   SCRPADX ;R eturn Scra tchpad IEN
  22073   "RTN","RCD PEWLZ",175 ,0)
  22074    Q RCSCR
  22075   "RTN","RCD PEX1")
  22076   0^7^B23011 676
  22077   "RTN","RCD PEX1",1,0)
  22078   RCDPEX1 ;A LB/TMK - E LECTRONIC  EOB MESSAG E EXCEPTIO NS PROCESS  ;2 Aug 20 18 21:41:0 5
  22079   "RTN","RCD PEX1",2,0)
  22080    ;;4.5;Acc ounts Rece ivable;**1 73,262,298 ,304,326,3 32**;Mar 2 0, 1995;Bu ild 34
  22081   "RTN","RCD PEX1",3,0)
  22082    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  22083   "RTN","RCD PEX1",4,0)
  22084    ;
  22085   "RTN","RCD PEX1",5,0)
  22086   EN ; Main  entry poin t
  22087   "RTN","RCD PEX1",6,0)
  22088    D DT^DICR W
  22089   "RTN","RCD PEX1",7,0)
  22090    N RCFASTX T,RCDA,RCE XCTYP,RCIN CEX,DIR,Y, X,RCPAR,RC PAY,RCQUIT ,RCTYPE,XX
  22091   "RTN","RCD PEX1",8,0)
  22092    ; Ask for  TRANSMISS ION except ions or DA TA excepti ons
  22093   "RTN","RCD PEX1",9,0)
  22094    S DIR("A" )="DO YOU  WANT TO SE E (T)RANSM ISSION OR  (D)ATA EXC EPTIONS?:  ",DIR("B") ="T",DIR(0 )="SAO^T:T RANSMISSIO N;D:DATA"
  22095   "RTN","RCD PEX1",10,0 )
  22096    S DIR("?" ,1)="TRANS MISSION EX CEPTIONS I NCLUDE ANY  PROBLEM E NCOUNTERED  WHEN AN E RA/EEOB",D IR("?",2)= "  IS RECE IVED AT TH E SITE AND  BEFORE IT  IS STORED  PERMANENT LY IN VIST A."
  22097   "RTN","RCD PEX1",11,0 )
  22098    S DIR("?" ,3)="  THI S INCLUDES  PARTIAL M ESSAGE REC EIPTS, EXT RACT PROBL EMS AND EE OBs THAT " ,DIR("?",4 )="  WERE  TRANSFERRE D IN FROM  ANOTHER SI TE."
  22099   "RTN","RCD PEX1",12,0 )
  22100    S DIR("?" ,5)="DATA  EXCEPTIONS  INCLUDE E EOB DETAIL  RECORDS F OR SPECIFI C BILLS TH AT CAN'T B E"
  22101   "RTN","RCD PEX1",13,0 )
  22102    S DIR("?" ,6)="  FUL LY PROCESS ED INTO TH E VISTA SY STEM.  THI S INCLUDES  EEOB DETA IL FOR",DI R("?",7)="   CLAIMS T HAT NEED T O BE TRANS FERRED TO  ANOTHER SI TE OR WHOS E DETAIL C OULD",DIR( "?")="  NO T BE STORE D IN IB"
  22103   "RTN","RCD PEX1",14,0 )
  22104    D ^DIR K  DIR
  22105   "RTN","RCD PEX1",15,0 )
  22106    I Y=""!(Y ="^") Q
  22107   "RTN","RCD PEX1",16,0 )
  22108    S RCEXCTY P=Y,RCQUIT =0
  22109   "RTN","RCD PEX1",17,0 )
  22110    I RCEXCTY P="D" D  ;  Include e xceptions  for MEDICA L, PHARMAC Y or BOTH  - PRCA*4.5 *298 Filte r question  for medic al, pharma cy or both
  22111   "RTN","RCD PEX1",18,0 )
  22112    . S RCTYP E=$$RTYPE^ RCDPEU1("A ") ; PRCA* 4.5*326 Pi ck MEDICAL /PHARMACY/ TRICARE/AL L
  22113   "RTN","RCD PEX1",19,0 )
  22114    . I RCTYP E=-1 S RCQ UIT=1 Q
  22115   "RTN","RCD PEX1",20,0 )
  22116    . ;
  22117   "RTN","RCD PEX1",21,0 )
  22118    . S RCPAY =$$PAYRNG^ RCDPEU1()     ; PRCA* 4.5*326 Ne w payer se lection
  22119   "RTN","RCD PEX1",22,0 )
  22120    . I RCTYP E=-1 S RCQ UIT=1 Q
  22121   "RTN","RCD PEX1",23,0 )
  22122    . I RCPAY '="A" D  ;
  22123   "RTN","RCD PEX1",24,0 )
  22124    ..  S RCP AR("TYPE") =RCTYPE,RC PAR("SELC" )=RCPAY
  22125   "RTN","RCD PEX1",25,0 )
  22126    ..  S RCP AR("DICA") ="Select I nsurance C ompany NAM E: "
  22127   "RTN","RCD PEX1",26,0 )
  22128    ..  S XX= $$SELPAY^R CDPEU1(.RC PAR)
  22129   "RTN","RCD PEX1",27,0 )
  22130    ..  I XX= -1 S RCQUI T=1
  22131   "RTN","RCD PEX1",28,0 )
  22132    ;
  22133   "RTN","RCD PEX1",29,0 )
  22134    ; Exit if  the user  asks to ex it. 
  22135   "RTN","RCD PEX1",30,0 )
  22136    I RCQUIT  Q
  22137   "RTN","RCD PEX1",31,0 )
  22138    ;
  22139   "RTN","RCD PEX1",32,0 )
  22140    ; Transmi ssion exce ptions
  22141   "RTN","RCD PEX1",33,0 )
  22142    I RCEXCTY P="T" D EN ^VALM("RCD PEX EOB EX CEPTION LI ST")
  22143   "RTN","RCD PEX1",34,0 )
  22144    I RCEXCTY P="D" D EN ^VALM("RCD PEX EOB_SU M EXCEPTIO N LIST")
  22145   "RTN","RCD PEX1",35,0 )
  22146    K RCFASTX T,RCDA
  22147   "RTN","RCD PEX1",36,0 )
  22148    Q
  22149   "RTN","RCD PEX1",37,0 )
  22150    ;
  22151   "RTN","RCD PEX1",38,0 )
  22152   EN1 ; Dupl icate ERA  Worklist [ RCDPE DUPL ICATE ERA  WORKLIST]  option
  22153   "RTN","RCD PEX1",39,0 )
  22154    D EN^VALM ("RCDPEX D UPLICATE E RA LIST")
  22155   "RTN","RCD PEX1",40,0 )
  22156    K RCFASTX T,RCDA
  22157   "RTN","RCD PEX1",41,0 )
  22158    Q
  22159   "RTN","RCD PEX1",42,0 )
  22160    ;
  22161   "RTN","RCD PEX1",43,0 )
  22162   INITD ; se t up initi al variabl es (RCDPEX  DUPLICATE  ERA LIST)
  22163   "RTN","RCD PEX1",44,0 )
  22164    S U="^",V ALMCNT=0,V ALMBG=1
  22165   "RTN","RCD PEX1",45,0 )
  22166    D BLD("DU PLICATE ER A")
  22167   "RTN","RCD PEX1",46,0 )
  22168    Q
  22169   "RTN","RCD PEX1",47,0 )
  22170    ;
  22171   "RTN","RCD PEX1",48,0 )
  22172   INIT ; set  up initia l variable s
  22173   "RTN","RCD PEX1",49,0 )
  22174    S U="^",V ALMCNT=0,V ALMBG=1
  22175   "RTN","RCD PEX1",50,0 )
  22176    D BLD("TR ANSMISSION ")
  22177   "RTN","RCD PEX1",51,0 )
  22178    Q
  22179   "RTN","RCD PEX1",52,0 )
  22180    ;
  22181   "RTN","RCD PEX1",53,0 )
  22182   BLD(MODE)  ; -- build  list of m essages
  22183   "RTN","RCD PEX1",54,0 )
  22184    ; INPUT:  MODE = "TR ANSMISSION " or "DUPL ICATE ERA"
  22185   "RTN","RCD PEX1",55,0 )
  22186    ; OUTPUT:  ^TMP("RCD PEX-EOB",$ J)
  22187   "RTN","RCD PEX1",56,0 )
  22188    N DA,DR,R CSEQ,RCMSG ,RCS,RCER, RCDPDATA,R C0,RCDUP,X ,Z
  22189   "RTN","RCD PEX1",57,0 )
  22190    K ^TMP("R CDPEX-EOB" ,$J),^TMP( "RCDPEX-EO BDX",$J)
  22191   "RTN","RCD PEX1",58,0 )
  22192    S (RCMSG, RCSEQ,VALM CNT)=0
  22193   "RTN","RCD PEX1",59,0 )
  22194    ; Extract  from 344. 5
  22195   "RTN","RCD PEX1",60,0 )
  22196    F  S RCMS G=$O(^RCY( 344.5,"AEX C",1,RCMSG )) Q:'RCMS G  S RC0=$ G(^RCY(344 .5,RCMSG,0 )) D
  22197   "RTN","RCD PEX1",61,0 )
  22198    . ; Check  if messag e is on du plicate ER A worklist
  22199   "RTN","RCD PEX1",62,0 )
  22200    . S RCDUP =+$$GET1^D IQ(344.5,R CMSG_",",. 15,"I")
  22201   "RTN","RCD PEX1",63,0 )
  22202    . ; Only  display me ssages rel evant to w orklist ty pe
  22203   "RTN","RCD PEX1",64,0 )
  22204    . I MODE= "TRANSMISS ION",RCDUP  Q
  22205   "RTN","RCD PEX1",65,0 )
  22206    . I MODE= "DUPLICATE  ERA",'RCD UP Q
  22207   "RTN","RCD PEX1",66,0 )
  22208    . ; add t o list
  22209   "RTN","RCD PEX1",67,0 )
  22210    . S RCSEQ =RCSEQ+1
  22211   "RTN","RCD PEX1",68,0 )
  22212    . S DR=". 01:.03;.1; .11",DA=RC MSG D DIQ3 445(DA,DR)
  22213   "RTN","RCD PEX1",69,0 )
  22214    . S X=""
  22215   "RTN","RCD PEX1",70,0 )
  22216    . S X=$$S ETSTR^VALM 1($E(RCSEQ _"    ",1, 4)_"  "_$G (RCDPDATA( 344.5,RCMS G,.01,"E") ),"",1,26)   ;(#.01)  MESSAGE ID  [1F]
  22217   "RTN","RCD PEX1",71,0 )
  22218    . S X=$$S ETSTR^VALM 1("  "_$E( $G(RCDPDAT A(344.5,RC MSG,.02,"I ")),4,6),X ,27,9)  ;( #.02) MESS AGE TYPE [ 2S]
  22219   "RTN","RCD PEX1",72,0 )
  22220    . S X=$$S ETSTR^VALM 1("  "_$G( RCDPDATA(3 44.5,RCMSG ,.03,"E")) ,X,36,22)   ;(#.03) D ATE RECORD ED [3D]
  22221   "RTN","RCD PEX1",73,0 )
  22222    . S X=$$S ETSTR^VALM 1("  "_$G( RCDPDATA(3 44.5,RCMSG ,.11,"E")) ,X,58,17)   ;(#.11) M AIL MESSAG E [11F] 
  22223   "RTN","RCD PEX1",74,0 )
  22224    . D SET(X ,344.5,RCM SG,RCSEQ)
  22225   "RTN","RCD PEX1",75,0 )
  22226    . S X="     EXCEPTIO N: "_$G(RC DPDATA(344 .5,RCMSG,. 1,"E"))  ; (#.1) EXCE PTION CATE GORY [10S]
  22227   "RTN","RCD PEX1",76,0 )
  22228    . D SET(X ,344.5,RCM SG,RCSEQ)
  22229   "RTN","RCD PEX1",77,0 )
  22230    . S DR=1, DA=RCMSG D  DIQ3445(D A,DR) ;(#1 ) DISPLAY  DATA
  22231   "RTN","RCD PEX1",78,0 )
  22232    . S Z=0 F   S Z=$O(R CDPDATA(34 4.5,RCMSG, 1,Z)) Q:'Z   S X="       "_RCDPD ATA(344.5, RCMSG,1,Z)  D SET(X,3 44.5,RCMSG ,RCSEQ)
  22233   "RTN","RCD PEX1",79,0 )
  22234    ;
  22235   "RTN","RCD PEX1",80,0 )
  22236    I '$D(^TM P("RCDPEX- EOB",$J))  S VALMCNT= 2,^TMP("RC DPEX-EOB", $J,1,0)="  ",^TMP("RC DPEX-EOB", $J,2,0)="    There Ar e No EEOB  Exception  Records On  File"
  22237   "RTN","RCD PEX1",81,0 )
  22238    Q
  22239   "RTN","RCD PEX1",82,0 )
  22240    ;
  22241   "RTN","RCD PEX1",83,0 )
  22242   FNL ; -- C lean up li st
  22243   "RTN","RCD PEX1",84,0 )
  22244    K ^TMP("R CDPEX-EOBD X",$J),^TM P("RCDPEU1 ",$J) ; PR CA*4.5*326
  22245   "RTN","RCD PEX1",85,0 )
  22246    D CLEAN^V ALM10
  22247   "RTN","RCD PEX1",86,0 )
  22248    K RCFASTX T
  22249   "RTN","RCD PEX1",87,0 )
  22250    Q
  22251   "RTN","RCD PEX1",88,0 )
  22252    ;
  22253   "RTN","RCD PEX1",89,0 )
  22254   SET(X,FILE ,RCMSG,RCS EQ) ; -- s et arrays  for EOB ex ception re cords
  22255   "RTN","RCD PEX1",90,0 )
  22256    ; X = the  data to s et into th e global
  22257   "RTN","RCD PEX1",91,0 )
  22258    S VALMCNT =VALMCNT+1 ,^TMP("RCD PEX-EOB",$ J,VALMCNT, 0)=X
  22259   "RTN","RCD PEX1",92,0 )
  22260    S ^TMP("R CDPEX-EOB" ,$J,"IDX", VALMCNT,RC SEQ)=""
  22261   "RTN","RCD PEX1",93,0 )
  22262    S ^TMP("R CDPEX-EOBD X",$J,RCSE Q)=VALMCNT _U_RCMSG_U _FILE
  22263   "RTN","RCD PEX1",94,0 )
  22264    Q
  22265   "RTN","RCD PEX1",95,0 )
  22266    ;
  22267   "RTN","RCD PEX1",96,0 )
  22268   HDR ;
  22269   "RTN","RCD PEX1",97,0 )
  22270    S VALMHDR (1)=$J("", 21)_"ERA/E EOB MESSAG ES WITH EX CEPTION CO NDITIONS"
  22271   "RTN","RCD PEX1",98,0 )
  22272    S VALMHDR (2)=" "
  22273   "RTN","RCD PEX1",99,0 )
  22274    Q
  22275   "RTN","RCD PEX1",100, 0)
  22276    ;
  22277   "RTN","RCD PEX1",101, 0)
  22278   HDR1 ;
  22279   "RTN","RCD PEX1",102, 0)
  22280    S VALMHDR (1)=$J("", 21)_"Dupli cate 835ER A Messages ",VALMHDR( 2)=" "
  22281   "RTN","RCD PEX1",103, 0)
  22282    Q
  22283   "RTN","RCD PEX1",104, 0)
  22284    ;
  22285   "RTN","RCD PEX1",105, 0)
  22286   DIQ3445(DA ,DR) ; DIQ  call to r etrieve da ta for DR  fields in  file 344.5
  22287   "RTN","RCD PEX1",106, 0)
  22288    N %I,D0,D IC,DIQ,DIQ 2,YY
  22289   "RTN","RCD PEX1",107, 0)
  22290    K RCDPDAT A(344.5)
  22291   "RTN","RCD PEX1",108, 0)
  22292    S DIQ(0)= "EI",DIC=" ^RCY(344.5 ,",DIQ="RC DPDATA" D  EN^DIQ1
  22293   "RTN","RCD PEX1",109, 0)
  22294    Q
  22295   "RTN","RCD PEX1",110, 0)
  22296    ;
  22297   "RTN","RCD PEX1",111, 0)
  22298   DIQ3444(DA ,DR) ; DIQ  call to r etrieve da ta for DR  fields in  file 344.4
  22299   "RTN","RCD PEX1",112, 0)
  22300    N %I,D0,D IC,DIQ,DIQ 2,YY
  22301   "RTN","RCD PEX1",113, 0)
  22302    K RCDPDAT A(344.4)
  22303   "RTN","RCD PEX1",114, 0)
  22304    S DIQ(0)= "EI",DIC=" ^RCY(344.4 ,",DIQ="RC DPDATA" D  EN^DIQ1
  22305   "RTN","RCD PEX1",115, 0)
  22306    Q
  22307   "RTN","RCD PEX1",116, 0)
  22308    ;
  22309   "RTN","RCD PEX5")
  22310   0^5^B66895 490
  22311   "RTN","RCD PEX5",1,0)
  22312   RCDPEX5 ;A LB/TMK,DWA  - ELECTRO NIC EOB EX CEPTION PR OCESSING -  FILE 344. 5 ;8 Aug 2 018 21:44: 13
  22313   "RTN","RCD PEX5",2,0)
  22314    ;;4.5;Acc ounts Rece ivable;**1 73,208,269 ,298,332** ;Mar 20, 1 995;Build  34
  22315   "RTN","RCD PEX5",3,0)
  22316    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  22317   "RTN","RCD PEX5",4,0)
  22318    Q
  22319   "RTN","RCD PEX5",5,0)
  22320    ;
  22321   "RTN","RCD PEX5",6,0)
  22322   UPD ; Upda te (File)  ERA msgs m anually fr om DUPLICA TE excepti on list fo r file 344 .5
  22323   "RTN","RCD PEX5",7,0)
  22324    N RC0,RCD A,RCLKBXDA ,RCOK,RCTS K,RCTYP,RC U,ZTSK
  22325   "RTN","RCD PEX5",8,0)
  22326    D FULL^VA LM1
  22327   "RTN","RCD PEX5",9,0)
  22328    D SEL(.RC DA,1)
  22329   "RTN","RCD PEX5",10,0 )
  22330    S RCDA=$O (RCDA(""))
  22331   "RTN","RCD PEX5",11,0 )
  22332    I RCDA=""  G UPDQ
  22333   "RTN","RCD PEX5",12,0 )
  22334    S RCLKBXD A=+RCDA(RC DA)
  22335   "RTN","RCD PEX5",13,0 )
  22336    S RC0=$G( ^RCY(344.5 ,RCLKBXDA, 0))
  22337   "RTN","RCD PEX5",14,0 )
  22338    I RC0=""  D  G UPDQ
  22339   "RTN","RCD PEX5",15,0 )
  22340    . W !,$C( 7)_"ERA #" _RCDA_" is  no longer  in except ion file"  S RCOK=0
  22341   "RTN","RCD PEX5",16,0 )
  22342    . D PAUSE ^VALM1
  22343   "RTN","RCD PEX5",17,0 )
  22344    ;
  22345   "RTN","RCD PEX5",18,0 )
  22346    I '$$LOCK (RCLKBXDA)  D  G UPDQ
  22347   "RTN","RCD PEX5",19,0 )
  22348    . W !,$C( 7)_"Could  not Lock E RA #"_RCDA _"  to fil e it." S R COK=0
  22349   "RTN","RCD PEX5",20,0 )
  22350    . D PAUSE ^VALM1
  22351   "RTN","RCD PEX5",21,0 )
  22352    ;
  22353   "RTN","RCD PEX5",22,0 )
  22354    S RC0=$G( ^RCY(344.5 ,RCLKBXDA, 0))
  22355   "RTN","RCD PEX5",23,0 )
  22356    I RC0=""  D  G UPDQ
  22357   "RTN","RCD PEX5",24,0 )
  22358    . W !,$C( 7)_"ERA #" _RCDA_" is  no longer  in except ion file"  S RCOK=0
  22359   "RTN","RCD PEX5",25,0 )
  22360    . D PAUSE ^VALM1
  22361   "RTN","RCD PEX5",26,0 )
  22362    I $P(RC0, U,5) S RCO K=1 D  G:' RCOK UPDQ
  22363   "RTN","RCD PEX5",27,0 )
  22364    . N ZTSK
  22365   "RTN","RCD PEX5",28,0 )
  22366    . S ZTSK= $P(RC0,U,5 ) D STAT^% ZTLOAD Q:Z TSK(0)=0   ;Task not  scheduled
  22367   "RTN","RCD PEX5",29,0 )
  22368    . I "12"[ ZTSK(1) W  !,$C(7)_"T his record  has alrea dy been sc heduled fo r update.  Task # is:  "_$P(RC0, U,5) S RCO K="" D PAU SE^VALM1
  22369   "RTN","RCD PEX5",30,0 )
  22370    ;
  22371   "RTN","RCD PEX5",31,0 )
  22372    S RCTYP=$ P(RC0,U,2)
  22373   "RTN","RCD PEX5",32,0 )
  22374    S RCU=$S( RCTYP="835 ERA":"NEWE RA^RCDPESR 2("_RCLKBX DA_",1)",R CTYP="835X FR":"FILEE OB^RCDPESR 5("_RCLKBX DA_")",1:" ")
  22375   "RTN","RCD PEX5",33,0 )
  22376    I RCU=""  W !,$C(7)_ "This mess age has an  invalid ' type' - ca n't update " D PAUSE^ VALM1 G UP DQ
  22377   "RTN","RCD PEX5",34,0 )
  22378    S RCTSK=$ $TASK(RCU, RCLKBXDA)
  22379   "RTN","RCD PEX5",35,0 )
  22380    I RCTSK W  !,"File u pdate has  been taske d (#"_RCTS K_")"
  22381   "RTN","RCD PEX5",36,0 )
  22382    I 'RCTSK  W !,$C(7)_ "File upda te could n ot be task ed. Please  try again  later!"
  22383   "RTN","RCD PEX5",37,0 )
  22384    D PAUSE^V ALM1
  22385   "RTN","RCD PEX5",38,0 )
  22386    ;
  22387   "RTN","RCD PEX5",39,0 )
  22388    D BLD^RCD PEX1("DUPL ICATE ERA" )
  22389   "RTN","RCD PEX5",40,0 )
  22390   UPDQ ; fal l through  or GOTO fr om above 
  22391   "RTN","RCD PEX5",41,0 )
  22392    I $G(RCLK BXDA) L -^ RCY(344.5, RCLKBXDA)
  22393   "RTN","RCD PEX5",42,0 )
  22394    S VALMBCK ="R"
  22395   "RTN","RCD PEX5",43,0 )
  22396    Q
  22397   "RTN","RCD PEX5",44,0 )
  22398    ;
  22399   "RTN","RCD PEX5",45,0 )
  22400   VP ; View/ Print ERA  Messages -  File 344. 5
  22401   "RTN","RCD PEX5",46,0 )
  22402    N DHD,DIC ,FLDS,BY,F R,TO,DIR,Y ,L,RCDA,RC TDA,RCRAW, POP
  22403   "RTN","RCD PEX5",47,0 )
  22404    D FULL^VA LM1,SEL(.R CDA,1)
  22405   "RTN","RCD PEX5",48,0 )
  22406    S RCDA=$O (RCDA(""))
  22407   "RTN","RCD PEX5",49,0 )
  22408    G:'RCDA V PQ
  22409   "RTN","RCD PEX5",50,0 )
  22410    S RCTDA=$ G(RCDA(RCD A))
  22411   "RTN","RCD PEX5",51,0 )
  22412    S DIR(0)= "YA",DIR(" A")="DO YO U WANT TO  INCLUDE DA TA THE WAY  IT WAS RE CEIVED (RA W DATA)?:  ",DIR("B") ="N" D ^DI R K DIR
  22413   "RTN","RCD PEX5",52,0 )
  22414    I $D(DUOU T)!$D(DTOU T) G VPQ
  22415   "RTN","RCD PEX5",53,0 )
  22416    S RCRAW=+ Y
  22417   "RTN","RCD PEX5",54,0 )
  22418    ; Ask dev ice
  22419   "RTN","RCD PEX5",55,0 )
  22420    N %ZIS,ZT RTN,ZTSAVE ,ZTDESC
  22421   "RTN","RCD PEX5",56,0 )
  22422    S %ZIS="Q M" D ^%ZIS  G:POP VPQ
  22423   "RTN","RCD PEX5",57,0 )
  22424    I $D(IO(" Q")) D  G  VPQ
  22425   "RTN","RCD PEX5",58,0 )
  22426    . S ZTRTN ="VPOUT^RC DPEX",ZTDE SC="AR - P rint EEOB  Exception  Message"
  22427   "RTN","RCD PEX5",59,0 )
  22428    . S ZTSAV E("RCTDA") ="",ZTSAVE ("RCRAW")= ""
  22429   "RTN","RCD PEX5",60,0 )
  22430    . D ^%ZTL OAD
  22431   "RTN","RCD PEX5",61,0 )
  22432    . W !!,$S ($D(ZTSK): "Your task  number"_Z TSK_" has  been queue d.",1:"Una ble to que ue this jo b.")
  22433   "RTN","RCD PEX5",62,0 )
  22434    . K ZTSK, IO("Q") D  HOME^%ZIS
  22435   "RTN","RCD PEX5",63,0 )
  22436    U IO
  22437   "RTN","RCD PEX5",64,0 )
  22438    ;
  22439   "RTN","RCD PEX5",65,0 )
  22440   VPOUT ; En trypoint f or queued  job
  22441   "RTN","RCD PEX5",66,0 )
  22442    N Z,Z0,RC STOP,RCPG, RCXM,RCXM1 ,RC,RCZ,RC TDAC,RCV5
  22443   "RTN","RCD PEX5",67,0 )
  22444    K ^TMP($J ,"RCRAW"), ^TMP($J,"R COUT")
  22445   "RTN","RCD PEX5",68,0 )
  22446    S RCTDAC= RCTDA_",", RCV5=0
  22447   "RTN","RCD PEX5",69,0 )
  22448    ;
  22449   "RTN","RCD PEX5",70,0 )
  22450    D GETS^DI Q(344.5,RC TDAC,"*"," IEN","RCZ" )
  22451   "RTN","RCD PEX5",71,0 )
  22452    D TXTDE^R CDPEX(RCTD A,.RCZ,1,. RCXM,.RC)
  22453   "RTN","RCD PEX5",72,0 )
  22454    ;
  22455   "RTN","RCD PEX5",73,0 )
  22456    I $O(^RCY (344.5,RCT DA,"EX",0) ) D
  22457   "RTN","RCD PEX5",74,0 )
  22458    . S RC=RC +1,RCXM(RC )="**EXCEP TION MESSA GES**"
  22459   "RTN","RCD PEX5",75,0 )
  22460    . D TXTDE ^RCDPEX(RC TDA,.RCZ,5 ,.RCXM,.RC )
  22461   "RTN","RCD PEX5",76,0 )
  22462    ;
  22463   "RTN","RCD PEX5",77,0 )
  22464    K ^TMP("R CSAVE",$J)
  22465   "RTN","RCD PEX5",78,0 )
  22466    M ^TMP("R CSAVE",$J) =^RCY(344. 5,RCTDA,2)
  22467   "RTN","RCD PEX5",79,0 )
  22468    I +$P($G( ^TMP("RCSA VE",$J,1,0 )),U,16)>0  S RCV5=1
  22469   "RTN","RCD PEX5",80,0 )
  22470    S Z=0 F   S Z=$O(^TM P("RCSAVE" ,$J,Z)) Q: 'Z  I $P($ G(^(Z,0)), U)["835" K  ^(0) Q  ;  Get rid o f header n ode
  22471   "RTN","RCD PEX5",81,0 )
  22472    D DISP^RC DPESR0("^T MP(""RCSAV E"",$J)"," ^TMP($J,"" RCRAW"")", 1,"^TMP($J ,""RCOUT"" )",75) ; G et formatt ed 'raw' d ata
  22473   "RTN","RCD PEX5",82,0 )
  22474    K ^TMP("R CSAVE",$J)
  22475   "RTN","RCD PEX5",83,0 )
  22476    I $G(RCRA W) D
  22477   "RTN","RCD PEX5",84,0 )
  22478    . S RC=$O (^TMP($J," RCOUT","") ,-1)+1,^TM P($J,"RCOU T",RC)=" "
  22479   "RTN","RCD PEX5",85,0 )
  22480    . S RC=RC +1,^TMP($J ,"RCOUT",R C)="**RAW  DATA**"
  22481   "RTN","RCD PEX5",86,0 )
  22482    . S Z=0 F   S Z=$O(^ RCY(344.5, RCTDA,2,Z) ) Q:'Z  D
  22483   "RTN","RCD PEX5",87,0 )
  22484    .. F Z0=1 :80:$L($G( ^RCY(344.5 ,RCTDA,2,Z ,0))) S RC =RC+1,^TMP ($J,"RCOUT ",RC)=$E($ G(^RCY(344 .5,RCTDA,2 ,Z,0)),Z0, Z0+79)
  22485   "RTN","RCD PEX5",88,0 )
  22486    ;
  22487   "RTN","RCD PEX5",89,0 )
  22488    S (RCPG,R CSTOP,Z)=0
  22489   "RTN","RCD PEX5",90,0 )
  22490    F  S Z=$O (RCXM(Z))  Q:'Z  S ^T MP($J,"RCO UT",Z-999) =RCXM(Z)
  22491   "RTN","RCD PEX5",91,0 )
  22492    S Z=""
  22493   "RTN","RCD PEX5",92,0 )
  22494    F  S Z=$O (^TMP($J," RCOUT",Z))  Q:'Z  D   Q:RCSTOP
  22495   "RTN","RCD PEX5",93,0 )
  22496    . I $D(ZT QUEUED),$$ S^%ZTLOAD  S (RCSTOP, ZTSTOP)=1  K ZTREQ I  +$G(RCPG)  W !,"***TA SK STOPPED  BY USER** *" Q
  22497   "RTN","RCD PEX5",94,0 )
  22498    . I 'RCPG !(($Y+5)>I OSL) D  I  RCSTOP Q
  22499   "RTN","RCD PEX5",95,0 )
  22500    .. D:RCPG  ASK^RCDPE X(.RCSTOP)  I RCSTOP  Q
  22501   "RTN","RCD PEX5",96,0 )
  22502    .. D HDR( RCTDA,.RCP G)
  22503   "RTN","RCD PEX5",97,0 )
  22504    . W !,$G( ^TMP($J,"R COUT",Z))
  22505   "RTN","RCD PEX5",98,0 )
  22506    I 'RCSTOP ,RCPG D AS K^RCDPEX(. RCSTOP)
  22507   "RTN","RCD PEX5",99,0 )
  22508    ;
  22509   "RTN","RCD PEX5",100, 0)
  22510    I $D(ZTQU EUED) S ZT REQ="@"
  22511   "RTN","RCD PEX5",101, 0)
  22512    I '$D(ZTQ UEUED) D ^ %ZISC
  22513   "RTN","RCD PEX5",102, 0)
  22514    ;
  22515   "RTN","RCD PEX5",103, 0)
  22516   VPQ K ^TMP ($J,"RCRAW "),^TMP($J ,"RCOUT")
  22517   "RTN","RCD PEX5",104, 0)
  22518    S VALMBCK ="R"
  22519   "RTN","RCD PEX5",105, 0)
  22520    Q
  22521   "RTN","RCD PEX5",106, 0)
  22522    ;
  22523   "RTN","RCD PEX5",107, 0)
  22524   SEL(RCDA,O NE) ; Sele ct entry(s ) from lis t
  22525   "RTN","RCD PEX5",108, 0)
  22526    ; RCDA =  array retu rned if se lections m ade
  22527   "RTN","RCD PEX5",109, 0)
  22528    ; RCDA(n) =ien of bi ll selecte d in file  344.5
  22529   "RTN","RCD PEX5",110, 0)
  22530    ; ONE = i f set to 1 , only one  selection  can be ma de at a ti me
  22531   "RTN","RCD PEX5",111, 0)
  22532    N RC
  22533   "RTN","RCD PEX5",112, 0)
  22534    K RCDA
  22535   "RTN","RCD PEX5",113, 0)
  22536    D EN^VALM 2($G(XQORN OD(0)),$S( '$G(ONE):" ",1:"S"))
  22537   "RTN","RCD PEX5",114, 0)
  22538    S RCDA=0  F  S RCDA= $O(VALMY(R CDA)) Q:'R CDA  S RC= $G(^TMP("R CDPEX-EOBD X",$J,RCDA )),RCDA(RC DA)=+$P(RC ,U,2)
  22539   "RTN","RCD PEX5",115, 0)
  22540    Q
  22541   "RTN","RCD PEX5",116, 0)
  22542    ;
  22543   "RTN","RCD PEX5",117, 0)
  22544   DEL ; RCDP EX DELETE  DUP MESSAG E option
  22545   "RTN","RCD PEX5",118, 0)
  22546    ; Delete  messages f rom messag es list -  file 344.5
  22547   "RTN","RCD PEX5",119, 0)
  22548    N DIR,RC0 ,RCDA,RCDI Q,RCE,RCLK BXDA,RCOK, RCPAYTP,RC T,RCTYP,RC U,RCX,Z
  22549   "RTN","RCD PEX5",120, 0)
  22550    D FULL^VA LM1
  22551   "RTN","RCD PEX5",121, 0)
  22552    S RCLKBXD A=0
  22553   "RTN","RCD PEX5",122, 0)
  22554    D SEL(.RC DA,1)
  22555   "RTN","RCD PEX5",123, 0)
  22556    S RCDA=$O (RCDA(""))
  22557   "RTN","RCD PEX5",124, 0)
  22558    I RCDA=""  G DELQ
  22559   "RTN","RCD PEX5",125, 0)
  22560    S RCLKBXD A=+RCDA(RC DA),RCLKBX DA("iens") =RCLKBXDA_ ","
  22561   "RTN","RCD PEX5",126, 0)
  22562    S RCPAYTP =$$PAYTYP^ RCDPEX(RCL KBXDA)
  22563   "RTN","RCD PEX5",127, 0)
  22564    S DIR(0)= "YA",DIR(" A",1)="Thi s action w ill PERMAN ENTLY dele te an EDI  Lockbox me ssage from  your syst em",DIR("A ",2)="A bu lletin wil l be sent  to report  the deleti on",DIR("A ",3)=" "
  22565   "RTN","RCD PEX5",128, 0)
  22566    S DIR("A" )="Are you  sure you  want to co ntinue? ", DIR("B")=" NO"
  22567   "RTN","RCD PEX5",129, 0)
  22568    W ! D ^DI R K DIR
  22569   "RTN","RCD PEX5",130, 0)
  22570    G:Y'=1 DE LQ
  22571   "RTN","RCD PEX5",131, 0)
  22572    I '$$LOCK (RCLKBXDA)  D  G DELQ
  22573   "RTN","RCD PEX5",132, 0)
  22574    . K DIR
  22575   "RTN","RCD PEX5",133, 0)
  22576    . S DIR(0 )="EA",DIR ("A",1)="  ",DIR("A", 2)="Unable  to lock t he EDI LOC KBOX MESSA GE for del etion."
  22577   "RTN","RCD PEX5",134, 0)
  22578    . S DIR(" A")="Press  ENTER: "  D ^DIR
  22579   "RTN","RCD PEX5",135, 0)
  22580    S RC0=$G( ^RCY(344.5 ,RCLKBXDA, 0))
  22581   "RTN","RCD PEX5",136, 0)
  22582    ;
  22583   "RTN","RCD PEX5",137, 0)
  22584    I $P(RC0, U,5) S RCO K=1 D  G:' RCOK DELQ
  22585   "RTN","RCD PEX5",138, 0)
  22586    . N ZTSK
  22587   "RTN","RCD PEX5",139, 0)
  22588    . S ZTSK= $P(RC0,U,5 ) D STAT^% ZTLOAD Q:Z TSK(0)=0   ;Task not  scheduled
  22589   "RTN","RCD PEX5",140, 0)
  22590    . I "12"[ ZTSK(1) W  !,$C(7)_"T his Lockbo x message  is schedul ed for upd ate. Task  # is: "_$P (RC0,U,11)  S RCOK=""  D PAUSE^V ALM1
  22591   "RTN","RCD PEX5",141, 0)
  22592    ;
  22593   "RTN","RCD PEX5",142, 0)
  22594    S DIR(0)= "YA",DIR(" A",1)=" ", DIR("A",2) ="",$P(DIR ("A",2),"* ",66)="",D IR("A",3)= "* This ED I Lockbox  message is  about to  be PERMANE NTLY delet ed!! *",DI R("A",4)=D IR("A",2), DIR("A",5) =" "
  22595   "RTN","RCD PEX5",143, 0)
  22596    S DIR("A" )="Are you  STILL sur e you want  to contin ue? ",DIR( "B")="NO"
  22597   "RTN","RCD PEX5",144, 0)
  22598    W ! D ^DI R W ! K DI R
  22599   "RTN","RCD PEX5",145, 0)
  22600    I Y'=1 W  !!,"Nothin g deleted"  D PAUSE^V ALM1 G DEL Q
  22601   "RTN","RCD PEX5",146, 0)
  22602    ;
  22603   "RTN","RCD PEX5",147, 0)
  22604    D SNDMLMN (RCLKBXDA) ,LKBXDEL(R CLKBXDA)
  22605   "RTN","RCD PEX5",148, 0)
  22606    I $D(^RCY (344.5,RCL KBXDA)) D   G DELQ
  22607   "RTN","RCD PEX5",149, 0)
  22608    . W !,"ED I Lockbox  message no t deleted  - problem  with delet ion." D PA USE^VALM1
  22609   "RTN","RCD PEX5",150, 0)
  22610    ;
  22611   "RTN","RCD PEX5",151, 0)
  22612    W !,"A Ma ilMan mess age has be en sent to  report th is deletio n.",!
  22613   "RTN","RCD PEX5",152, 0)
  22614    D PAUSE^V ALM1,BLD^R CDPEX1("DU PLICATE ER A")
  22615   "RTN","RCD PEX5",153, 0)
  22616    ;
  22617   "RTN","RCD PEX5",154, 0)
  22618   DELQ ; fal l through  or GOTO he re
  22619   "RTN","RCD PEX5",155, 0)
  22620    L -^RCY(3 44.5,RCLKB XDA,0)
  22621   "RTN","RCD PEX5",156, 0)
  22622    S VALMBCK ="R"
  22623   "RTN","RCD PEX5",157, 0)
  22624    Q
  22625   "RTN","RCD PEX5",158, 0)
  22626    ;
  22627   "RTN","RCD PEX5",159, 0)
  22628   SNDMLMN(RC LKBXDA) ;  send MailM an message  about RCL KBXDA entr y in 344.5
  22629   "RTN","RCD PEX5",160, 0)
  22630    N J,LN,RC DPDATA,X,X MINSTR,XMT O,XMZ,Y
  22631   "RTN","RCD PEX5",161, 0)
  22632    K ^TMP($J ,"RCMMSG")   ; mail t ext storag e
  22633   "RTN","RCD PEX5",162, 0)
  22634    S DR=".01 :.04;.07:. 15"
  22635   "RTN","RCD PEX5",163, 0)
  22636    D DIQ3445 ^RCDPEX1(R CLKBXDA,DR )  ; retur ns RCDPDAT A array
  22637   "RTN","RCD PEX5",164, 0)
  22638    ; create  MailMan te xt
  22639   "RTN","RCD PEX5",165, 0)
  22640    S LN=1,^T MP($J,"RCM MSG",LN,0) ="An EDI L OCKBOX MES SAGE was d eleted "_$ $FMTE^XLFD T($$NOW^XL FDT)
  22641   "RTN","RCD PEX5",166, 0)
  22642    S LN=LN+1 ,^TMP($J," RCMMSG",LN ,0)="The u ser: "_$$G ET1^DIQ(20 0,DUZ_",", .01)_"  (U ser #"_DUZ _")"
  22643   "RTN","RCD PEX5",167, 0)
  22644    S LN=LN+1 ,^TMP($J," RCMMSG",LN ,0)=" ",LN =LN+1,^TMP ($J,"RCMMS G",LN,0)=" Deleted Lo ckbox Mess age Inform ation: "
  22645   "RTN","RCD PEX5",168, 0)
  22646    ; add dat a and fiel d labels t o message
  22647   "RTN","RCD PEX5",169, 0)
  22648    F J=.01:. 01:.04,.07 :.01:.15 D
  22649   "RTN","RCD PEX5",170, 0)
  22650    . S X=$G( RCDPDATA(3 44.5,RCLKB XDA,J,"E") ) Q:X=""   ; skip nul l fields
  22651   "RTN","RCD PEX5",171, 0)
  22652    . S LN=LN +1,^TMP($J ,"RCMMSG", LN,0)=" >  "_$$GET1^D ID(344.5,J ,"","LABEL ")_": "_X
  22653   "RTN","RCD PEX5",172, 0)
  22654    ; send as  a priorit y message
  22655   "RTN","RCD PEX5",173, 0)
  22656    S XMTO(DU Z)="",XMTO ("G.RCDPE  PAYMENTS M GMT")="",X MINSTR("FL AGS")="P"
  22657   "RTN","RCD PEX5",174, 0)
  22658    D SENDMSG ^XMXAPI(DU Z,"EDI LOC KBOX MESSA GE DELETIO N",$NA(^TM P($J,"RCMM SG")),.XMT O,.XMINSTR ,.XMZ)
  22659   "RTN","RCD PEX5",175, 0)
  22660    I '$G(ZTS K),$E(IOST ,1,2)="C-" ,$G(XMZ) W  !,"MailMa n message  #"_XMZ_" s ent."
  22661   "RTN","RCD PEX5",176, 0)
  22662    K ^TMP($J ,"RCMMSG")
  22663   "RTN","RCD PEX5",177, 0)
  22664    Q
  22665   "RTN","RCD PEX5",178, 0)
  22666    ;
  22667   "RTN","RCD PEX5",179, 0)
  22668   LKBXDEL(RC LKBXDA) ;D elete entr y from AR  EDI LOCKBO X MESSAGES  file
  22669   "RTN","RCD PEX5",180, 0)
  22670    N DA,DIC, DIK,X,Y S  DIK="^RCY( 344.5,",DA =RCLKBXDA  D ^DIK
  22671   "RTN","RCD PEX5",181, 0)
  22672    Q
  22673   "RTN","RCD PEX5",182, 0)
  22674    ;
  22675   "RTN","RCD PEX5",183, 0)
  22676   TASK(RCRTN ,RCLKBXDA)  ;function , Schedule  the task  to update  data base  from messa ge
  22677   "RTN","RCD PEX5",184, 0)
  22678    ; RCRTN -  routine t o task
  22679   "RTN","RCD PEX5",185, 0)
  22680    ; RCLKBXD A - IEN in  file 344. 5
  22681   "RTN","RCD PEX5",186, 0)
  22682    ; returns : TaskMan  task #
  22683   "RTN","RCD PEX5",187, 0)
  22684    N ZTSK,ZT DESC,ZTIO, ZTDTH,ZTSA VE,DA,DR,D IE
  22685   "RTN","RCD PEX5",188, 0)
  22686    S ZTIO="" ,ZTDTH=$H, ZTDESC="UP DATE DATA  BASE FROM  EEOB EXCEP TION PROCE SSING",ZTS AVE("RC*") ="",ZTRTN= RCRTN
  22687   "RTN","RCD PEX5",189, 0)
  22688    D ^%ZTLOA D
  22689   "RTN","RCD PEX5",190, 0)
  22690    I $G(ZTSK ),$G(^RCY( 344.5,RCLK BXDA,0)) D
  22691   "RTN","RCD PEX5",191, 0)
  22692    . S DIE=" ^RCY(344.5 ,",DR=".05 ///"_ZTSK_ ";.04///1; .08///0",D A=RCLKBXDA  D ^DIE
  22693   "RTN","RCD PEX5",192, 0)
  22694    Q $G(ZTSK )
  22695   "RTN","RCD PEX5",193, 0)
  22696    ;
  22697   "RTN","RCD PEX5",194, 0)
  22698   LOCK(RCLKB XDA) ; Boo lean funct ion, lock  entry RCLK BXDA in fi le 344.5
  22699   "RTN","RCD PEX5",195, 0)
  22700    ; Return  1 if succe ssful, els e zero
  22701   "RTN","RCD PEX5",196, 0)
  22702    Q:'($G(RC LKBXDA)>0)  "^no 344. 5 IEN to l ock"  ; er ror messag e is also  false
  22703   "RTN","RCD PEX5",197, 0)
  22704    N LCK L + ^RCY(344.5 ,RCLKBXDA, 0):DILOCKT M S LCK=$T
  22705   "RTN","RCD PEX5",198, 0)
  22706    Q LCK
  22707   "RTN","RCD PEX5",199, 0)
  22708    ;
  22709   "RTN","RCD PEX5",200, 0)
  22710   HDR(RCTDA, RCPG) ;Pri nts report  heading
  22711   "RTN","RCD PEX5",201, 0)
  22712    ; RCTDA =  ien of fi le 344.5
  22713   "RTN","RCD PEX5",202, 0)
  22714    ; RCPG =  page # las t printed
  22715   "RTN","RCD PEX5",203, 0)
  22716    N Z
  22717   "RTN","RCD PEX5",204, 0)
  22718    I RCPG!($ E(IOST,1,2 )="C-") W  @IOF,*13
  22719   "RTN","RCD PEX5",205, 0)
  22720    I 'RCPG D
  22721   "RTN","RCD PEX5",206, 0)
  22722    . N RCX,R CZ
  22723   "RTN","RCD PEX5",207, 0)
  22724    . D TXT0^ RCDPEX(RCT DA,.RCZ,.R CX,0) ; Ge t 0-node c aptioned f ields
  22725   "RTN","RCD PEX5",208, 0)
  22726    . S Z=0 F   S Z=$O(R CX(Z)) Q:' Z  S ^TMP( $J,"RCHDR_ EX",Z)=RCX (Z)
  22727   "RTN","RCD PEX5",209, 0)
  22728    S RCPG=RC PG+1
  22729   "RTN","RCD PEX5",210, 0)
  22730    W !,?15," EDI LBOX -  DUPLICATE  ERA - EEO B DETAIL", ?55,$$FMTE ^XLFDT(DT, 2),?70,"Pa ge: ",RCPG ,!
  22731   "RTN","RCD PEX5",211, 0)
  22732    S Z=0 F   S Z=$O(^TM P($J,"RCHD R_EX",Z))  Q:'Z  W !, $G(^(Z))
  22733   "RTN","RCD PEX5",212, 0)
  22734    W !,$TR($ J("",IOM), " ","=")
  22735   "RTN","RCD PEX5",213, 0)
  22736    Q
  22737   "RTN","RCD PLPL3")
  22738   0^36^B6180 8211
  22739   "RTN","RCD PLPL3",1,0 )
  22740   RCDPLPL3 ; WISC/RFJ -  link paym ents listm anager opt ions (link  payment)  ;1 Jun 00
  22741   "RTN","RCD PLPL3",2,0 )
  22742    ;;4.5;Acc ounts Rece ivable;**1 53,304,301 ,321,332** ;Mar 20, 1 995;Build  34
  22743   "RTN","RCD PLPL3",3,0 )
  22744    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  22745   "RTN","RCD PLPL3",4,0 )
  22746    Q
  22747   "RTN","RCD PLPL3",5,0 )
  22748    ;
  22749   "RTN","RCD PLPL3",6,0 )
  22750    ;
  22751   "RTN","RCD PLPL3",7,0 )
  22752   LINKPAY ;   link a pa yment to a n account
  22753   "RTN","RCD PLPL3",8,0 )
  22754    N DA,DIR, DIRUT,DIRO UT,DTOUT,D UOUT,RCEEO B,X,Y ; PR CA*4.5*321  - added R CEEOB
  22755   "RTN","RCD PLPL3",9,0 )
  22756    ;
  22757   "RTN","RCD PLPL3",10, 0)
  22758    D FULL^VA LM1
  22759   "RTN","RCD PLPL3",11, 0)
  22760    S VALMBCK ="R"
  22761   "RTN","RCD PLPL3",12, 0)
  22762    ;
  22763   "RTN","RCD PLPL3",13, 0)
  22764    W !!,"Thi s option w ill allow  the accoun t to be en tered for  an unappli ed"
  22765   "RTN","RCD PLPL3",14, 0)
  22766    W !,"paym ent transa ction sele cted from  the above  list.  If  the select ed"
  22767   "RTN","RCD PLPL3",15, 0)
  22768    W !,"rece ipt has be en previou sly proces sed, the s elected ac count in t he"
  22769   "RTN","RCD PLPL3",16, 0)
  22770    W !,"acco unts recei vable pack age will b e updated  with the p ayment.",!
  22771   "RTN","RCD PLPL3",17, 0)
  22772    N INDEX,R CDPFLAG,RC ERROR,RCGE CSCR,RCPAY ,RCRECTDA, RCSTATUS,R CTRANDA,RC DCHKSW,HRC DCKSW,RCDP TYPE
  22773   "RTN","RCD PLPL3",18, 0)
  22774    S INDEX=$ $SELPAY^RC DPLPL1 I ' INDEX Q
  22775   "RTN","RCD PLPL3",19, 0)
  22776    S RCPAY=$ G(^TMP("RC DPLPLM",$J ,"IDX",IND EX,INDEX))
  22777   "RTN","RCD PLPL3",20, 0)
  22778    S RCRECTD A=+$P(RCPA Y,"^"),RCT RANDA=+$P( RCPAY,"^", 2)
  22779   "RTN","RCD PLPL3",21, 0)
  22780    ;
  22781   "RTN","RCD PLPL3",22, 0)
  22782    I '$$LOCK REC^RCDPRP LU(RCRECTD A) Q
  22783   "RTN","RCD PLPL3",23, 0)
  22784    S RCDPTYP E=$P(^RCY( 344,RCRECT DA,1,RCTRA NDA,0),"^" ,19)
  22785   "RTN","RCD PLPL3",24, 0)
  22786    ;
  22787   "RTN","RCD PLPL3",25, 0)
  22788    ;  check  to see if  the cr doc ument has  been sent  for the re ceipt
  22789   "RTN","RCD PLPL3",26, 0)
  22790    S RCGECSC R=$P($G(^R CY(344,RCR ECTDA,2)), "^")
  22791   "RTN","RCD PLPL3",27, 0)
  22792    ;  code s heet alrea dy sent on ce, this i s a retran smission,  check it
  22793   "RTN","RCD PLPL3",28, 0)
  22794    I RCGECSC R'="" D
  22795   "RTN","RCD PLPL3",29, 0)
  22796    .   S RCS TATUS=$$ST ATUS^GECSS GET(RCGECS CR)
  22797   "RTN","RCD PLPL3",30, 0)
  22798    .   W !!, "This rece ipt has be en process ed to FMS  with cash  receipt do cument"
  22799   "RTN","RCD PLPL3",31, 0)
  22800    .   W !,$ TR(RCGECSC R," "),".   The curre nt status  for this d ocument in  the"
  22801   "RTN","RCD PLPL3",32, 0)
  22802    .   W !," Generic Co de Sheet S tack file  is ",RCSTA TUS,"."
  22803   "RTN","RCD PLPL3",33, 0)
  22804    .   ;
  22805   "RTN","RCD PLPL3",34, 0)
  22806    .   ;  ok ay to cont inue if st atus is Er ror, Rejec ted, or no t defined  (-1)
  22807   "RTN","RCD PLPL3",35, 0)
  22808    .   I $E( RCSTATUS)= "E"!($E(RC STATUS)="R ")!(RCSTAT US=-1) Q
  22809   "RTN","RCD PLPL3",36, 0)
  22810    .   ;  ok ay to cont inue if st atus is Ac cepted
  22811   "RTN","RCD PLPL3",37, 0)
  22812    .   I $E( RCSTATUS)= "A" Q
  22813   "RTN","RCD PLPL3",38, 0)
  22814    .   ;  ok ay to cont inue if do cument is  transmitte d for 2 da ys
  22815   "RTN","RCD PLPL3",39, 0)
  22816    .   I $E( RCSTATUS)= "T",$$FMDI FF^XLFDT(D T,$P(^RCY( 344,RCRECT DA,0),"^", 8))>1 Q
  22817   "RTN","RCD PLPL3",40, 0)
  22818    .   ;
  22819   "RTN","RCD PLPL3",41, 0)
  22820    .   W !!, "You canno t link the  payment t o an accou nt until t he FMS cas h receipt"
  22821   "RTN","RCD PLPL3",42, 0)
  22822    .   W !," document i s either A ccepted or  Rejected  by FMS."
  22823   "RTN","RCD PLPL3",43, 0)
  22824    .   W !,"   1.  If t he FMS cas h receipt  is Accepte d by FMS,  you will n eed to"
  22825   "RTN","RCD PLPL3",44, 0)
  22826    .   W !,"       remo ve the pay ment from  the statio n's suspen se account  online"
  22827   "RTN","RCD PLPL3",45, 0)
  22828    .   W !,"       in F MS."
  22829   "RTN","RCD PLPL3",46, 0)
  22830    .   W !,"   2.  If t he FMS cas h receipt  document i s rejected  by FMS, y ou can"
  22831   "RTN","RCD PLPL3",47, 0)
  22832    .   W !,"       use  the option  Process R eceipt und er the Rec eipt Proce ssing"
  22833   "RTN","RCD PLPL3",48, 0)
  22834    .   W !,"       list manager sc reen to re generate t he documen t.  The pa yment"
  22835   "RTN","RCD PLPL3",49, 0)
  22836    .   W !,"       has  not been d eposited i n the stat ion's susp ense accou nt by"
  22837   "RTN","RCD PLPL3",50, 0)
  22838    .   W !,"       FMS  since the  cash recei pt documen t rejected .",!
  22839   "RTN","RCD PLPL3",51, 0)
  22840    .   S VAL MSG="Try l inking thi s payment  again tomo rrow."
  22841   "RTN","RCD PLPL3",52, 0)
  22842    .   D WRI TE^RCDPRPL U(VALMSG)
  22843   "RTN","RCD PLPL3",53, 0)
  22844    .   S RCD PFLAG=1
  22845   "RTN","RCD PLPL3",54, 0)
  22846    I $G(RCDP FLAG) D QU IT Q
  22847   "RTN","RCD PLPL3",55, 0)
  22848    ;
  22849   "RTN","RCD PLPL3",56, 0)
  22850    ;  show p ayment tra nsaction
  22851   "RTN","RCD PLPL3",57, 0)
  22852    W !!,"The  current p ayment tra nsaction:" ,?40,"RECE IPT: ",$P( ^RCY(344,R CRECTDA,0) ,"^")
  22853   "RTN","RCD PLPL3",58, 0)
  22854    W !,"---- ---------- ---------- --------"
  22855   "RTN","RCD PLPL3",59, 0)
  22856    D SHOWPAY (RCRECTDA, RCTRANDA)
  22857   "RTN","RCD PLPL3",60, 0)
  22858    ;
  22859   "RTN","RCD PLPL3",61, 0)
  22860    ;  transa ction has  account en tered
  22861   "RTN","RCD PLPL3",62, 0)
  22862    I $P(^RCY (344,RCREC TDA,1,RCTR ANDA,0),"^ ",3) D  Q
  22863   "RTN","RCD PLPL3",63, 0)
  22864    .   S VAL MSG="An ac count has  been assig ned to thi s payment. "
  22865   "RTN","RCD PLPL3",64, 0)
  22866    .   D QUI T
  22867   "RTN","RCD PLPL3",65, 0)
  22868    ;
  22869   "RTN","RCD PLPL3",66, 0)
  22870    ;  transa ction is c ancelled,  cannot edi t
  22871   "RTN","RCD PLPL3",67, 0)
  22872    I '$P(^RC Y(344,RCRE CTDA,1,RCT RANDA,0)," ^",4),$P($ G(^RCY(344 ,RCRECTDA, 1,RCTRANDA ,1)),"^")' ="" D  Q
  22873   "RTN","RCD PLPL3",68, 0)
  22874    .   S VAL MSG="Payme nt Transac tion "_RCT RANDA_" is  CANCELLED ."
  22875   "RTN","RCD PLPL3",69, 0)
  22876    .   D WRI TE^RCDPRPL U(VALMSG)
  22877   "RTN","RCD PLPL3",70, 0)
  22878    .   D QUI T
  22879   "RTN","RCD PLPL3",71, 0)
  22880    ;
  22881   "RTN","RCD PLPL3",72, 0)
  22882    ;PRCA*4.5 *304
  22883   "RTN","RCD PLPL3",73, 0)
  22884    ; Will th is link pa yment link  to multip le bills
  22885   "RTN","RCD PLPL3",74, 0)
  22886    ; Note:   some of th e code and  logic bel ow is also  in tag PR OCESS^RCDP LPL4.  
  22887   "RTN","RCD PLPL3",75, 0)
  22888    ;         If changes  in logic  are made b elow, plea se review  this tag a s well.
  22889   "RTN","RCD PLPL3",76, 0)
  22890    ;    
  22891   "RTN","RCD PLPL3",77, 0)
  22892    S DIR(0)= "YO",DIR(" B")="NO"
  22893   "RTN","RCD PLPL3",78, 0)
  22894    S DIR("A" )="  Will  this trans action be  linked to  multiple c laims (Y/N )"
  22895   "RTN","RCD PLPL3",79, 0)
  22896    D ^DIR
  22897   "RTN","RCD PLPL3",80, 0)
  22898    I $G(DTOU T)!($G(DUO UT)) D QUI T Q
  22899   "RTN","RCD PLPL3",81, 0)
  22900    I +Y D MU LTIPLE^RCD PLPL4(RCRE CTDA,RCTRA NDA,RCGECS CR,$G(RCST ATUS)) D Q UIT Q
  22901   "RTN","RCD PLPL3",82, 0)
  22902    ;end PRCA *4.5*304
  22903   "RTN","RCD PLPL3",83, 0)
  22904    ;
  22905   "RTN","RCD PLPL3",84, 0)
  22906    W !!,"Edi ting Payme nt: ",RCTR ANDA
  22907   "RTN","RCD PLPL3",85, 0)
  22908   DBTRBIL S  RCDCHKSW=1 ,HRCDCKSW= 0 D EDITAC CT^RCDPURE T(RCRECTDA ,RCTRANDA)  I RCDCHKS W=0 G DBTR BIL   ;prc a*4.5*301
  22909   "RTN","RCD PLPL3",86, 0)
  22910    W !
  22911   "RTN","RCD PLPL3",87, 0)
  22912    ;  accoun t not ente red
  22913   "RTN","RCD PLPL3",88, 0)
  22914    I '$P(^RC Y(344,RCRE CTDA,1,RCT RANDA,0)," ^",3) D  Q
  22915   "RTN","RCD PLPL3",89, 0)
  22916    .   S VAL MSG="Accou nt was not  linked."
  22917   "RTN","RCD PLPL3",90, 0)
  22918    .   D WRI TE^RCDPRPL U(VALMSG)
  22919   "RTN","RCD PLPL3",91, 0)
  22920    .   D QUI T
  22921   "RTN","RCD PLPL3",92, 0)
  22922    ;
  22923   "RTN","RCD PLPL3",93, 0)
  22924    ;  show p ayment tra nsaction
  22925   "RTN","RCD PLPL3",94, 0)
  22926    W !,"The  NEW paymen t transact ion:",?40, "RECEIPT:  ",$P(^RCY( 344,RCRECT DA,0),"^")
  22927   "RTN","RCD PLPL3",95, 0)
  22928    W !,"---- ---------- ---------- -----"
  22929   "RTN","RCD PLPL3",96, 0)
  22930    D SHOWPAY (RCRECTDA, RCTRANDA)
  22931   "RTN","RCD PLPL3",97, 0)
  22932    ;
  22933   "RTN","RCD PLPL3",98, 0)
  22934    I $$ASKAC CT()'=1 D   Q
  22935   "RTN","RCD PLPL3",99, 0)
  22936    .   D DEL EACCT^RCDP URET(RCREC TDA,RCTRAN DA)
  22937   "RTN","RCD PLPL3",100 ,0)
  22938    .   S VAL MSG="Accou nt was del eted and n ot linked. "
  22939   "RTN","RCD PLPL3",101 ,0)
  22940    .   D WRI TE^RCDPRPL U(VALMSG)
  22941   "RTN","RCD PLPL3",102 ,0)
  22942    .   D QUI T
  22943   "RTN","RCD PLPL3",103 ,0)
  22944    ;
  22945   "RTN","RCD PLPL3",104 ,0)
  22946    ; Option  to restore  suspense  EEOB - PRC A*4.5*321
  22947   "RTN","RCD PLPL3",105 ,0)
  22948    S RCEEOB= $$EEOB^RCD PEM5(RCREC TDA,RCTRAN DA)
  22949   "RTN","RCD PLPL3",106 ,0)
  22950    Q:RCEEOB< 0
  22951   "RTN","RCD PLPL3",107 ,0)
  22952    ;
  22953   "RTN","RCD PLPL3",108 ,0)
  22954    ;  receip t has been  processed  since the  cash rece ipt docume nt
  22955   "RTN","RCD PLPL3",109 ,0)
  22956    ;  has be en generat ed.  updat e the new  account wi th payment
  22957   "RTN","RCD PLPL3",110 ,0)
  22958    W !
  22959   "RTN","RCD PLPL3",111 ,0)
  22960    I RCGECSC R'="" D  I  RCERROR Q
  22961   "RTN","RCD PLPL3",112 ,0)
  22962    .   W !," Updating t he Linked  Account wi th the pay ment ..."
  22963   "RTN","RCD PLPL3",113 ,0)
  22964    .   S RCE RROR=$$PRO CESS^RCBEP AY(RCRECTD A,RCTRANDA )
  22965   "RTN","RCD PLPL3",114 ,0)
  22966    .   ;  an  error occ urred duri ng process ing a paym ent
  22967   "RTN","RCD PLPL3",115 ,0)
  22968    .   I RCE RROR D  Q
  22969   "RTN","RCD PLPL3",116 ,0)
  22970    .   .   W  !
  22971   "RTN","RCD PLPL3",117 ,0)
  22972    .   .   W  !,"+----- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---+"
  22973   "RTN","RCD PLPL3",118 ,0)
  22974    .   .   W  !,"|  An  ERROR has  occurred w hen proces sing payme nt ",RCTRA NDA," on r eceipt ",$ P(^RCY(344 ,RCRECTDA, 0),"^"),". ",?79,"|"
  22975   "RTN","RCD PLPL3",119 ,0)
  22976    .   .   W  !,"|  The  error mes sage retur ned during  processin g is:",?79 ,"|"
  22977   "RTN","RCD PLPL3",120 ,0)
  22978    .   .   W  !,"|",?79 ,"|"
  22979   "RTN","RCD PLPL3",121 ,0)
  22980    .   .   W  !,"|  ",$ P(RCERROR, "^",2),?79 ,"|"
  22981   "RTN","RCD PLPL3",122 ,0)
  22982    .   .   W  !,"|",?79 ,"|"
  22983   "RTN","RCD PLPL3",123 ,0)
  22984    .   .   W  !,"|  You  will need  to correc t the erro r before y ou can lin k the paym ent.",?79, "|"
  22985   "RTN","RCD PLPL3",124 ,0)
  22986    .   .   W  !,"+----- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---+"
  22987   "RTN","RCD PLPL3",125 ,0)
  22988    .   .   W  !
  22989   "RTN","RCD PLPL3",126 ,0)
  22990    .   .   D  DELEACCT^ RCDPURET(R CRECTDA,RC TRANDA)
  22991   "RTN","RCD PLPL3",127 ,0)
  22992    .   .   S  VALMSG="A ccount was  deleted a nd not lin ked."
  22993   "RTN","RCD PLPL3",128 ,0)
  22994    .   .   D  WRITE^RCD PRPLU(VALM SG)
  22995   "RTN","RCD PLPL3",129 ,0)
  22996    .   .   D  QUIT
  22997   "RTN","RCD PLPL3",130 ,0)
  22998    .   ;
  22999   "RTN","RCD PLPL3",131 ,0)
  23000    .   ;  pa yment proc essed corr ectly
  23001   "RTN","RCD PLPL3",132 ,0)
  23002    .   W "   done."
  23003   "RTN","RCD PLPL3",133 ,0)
  23004    .   W !
  23005   "RTN","RCD PLPL3",134 ,0)
  23006    .   ;
  23007   "RTN","RCD PLPL3",135 ,0)
  23008    .   ;PRCA *4.5*304
  23009   "RTN","RCD PLPL3",136 ,0)
  23010    .   D REM CMT^RCDPLP L4(RCRECTD A,RCTRANDA )   ; Remo ve the sus pense comm ent.  No l onger need ed. 
  23011   "RTN","RCD PLPL3",137 ,0)
  23012    .   ;
  23013   "RTN","RCD PLPL3",138 ,0)
  23014    .   ;File  entry in  Audit Log
  23015   "RTN","RCD PLPL3",139 ,0)
  23016    .   D AUD IT^RCBEPAY (RCRECTDA, RCTRANDA," P")
  23017   "RTN","RCD PLPL3",140 ,0)
  23018    .   ;
  23019   "RTN","RCD PLPL3",141 ,0)
  23020    .   ; Upd ate Suspen se Status
  23021   "RTN","RCD PLPL3",142 ,0)
  23022    .   D SUS PDIS^RCBEP AY(RCRECTD A,RCTRANDA ,"PD")
  23023   "RTN","RCD PLPL3",143 ,0)
  23024    .   ;end  PRCA*4.5*3 04
  23025   "RTN","RCD PLPL3",144 ,0)
  23026    .   ;
  23027   "RTN","RCD PLPL3",145 ,0)
  23028    .   ; Upd ate EEOB c laim numbe r and rest ore to act ive status  - PRCA*4. 5*321
  23029   "RTN","RCD PLPL3",146 ,0)
  23030    .   D:RCE EOB RESTOR E^RCDPEM5( RCRECTDA,R CTRANDA,RC EEOB,"L")
  23031   "RTN","RCD PLPL3",147 ,0)
  23032    .   ;
  23033   "RTN","RCD PLPL3",148 ,0)
  23034    .   ; PRC A*4.5*332  - If all m oney was s plit off t he origina l EEOB rem ove it. 
  23035   "RTN","RCD PLPL3",149 ,0)
  23036    .   D CHK EOB^RCDPEU 2(RCRECTDA ,RCTRANDA)
  23037   "RTN","RCD PLPL3",150 ,0)
  23038    .   ;
  23039   "RTN","RCD PLPL3",151 ,0)
  23040    .   I $E( $G(RCSTATU S))="A" D
  23041   "RTN","RCD PLPL3",152 ,0)
  23042    .   .   W  !,"Since  the FMS ca sh receipt  document  is Accepte d in FMS,  you need t o go"
  23043   "RTN","RCD PLPL3",153 ,0)
  23044    .   .   W  !,"online  in FMS an d transfer  the amoun t paid out  of the st ation's su spense"
  23045   "RTN","RCD PLPL3",154 ,0)
  23046    .   .   W  !,"accoun t.",!
  23047   "RTN","RCD PLPL3",155 ,0)
  23048    .   .   ;   send mai l message  to the RCD P PAYMENTS  mail grou p
  23049   "RTN","RCD PLPL3",156 ,0)
  23050    .   .   W  !,"Sendin g mail mes sage to RC DP PAYMENT S mail gro up."
  23051   "RTN","RCD PLPL3",157 ,0)
  23052    .   .   D  MAILMSG^R CDPLPSR(RC RECTDA,RCT RANDA)
  23053   "RTN","RCD PLPL3",158 ,0)
  23054    .   .   ;   place an  x in the  fms doc fi eld so it  will show  on the
  23055   "RTN","RCD PLPL3",159 ,0)
  23056    .   .   ;   suspense  report
  23057   "RTN","RCD PLPL3",160 ,0)
  23058    .   .   D  EDITFMS^R CDPURET(RC RECTDA,RCT RANDA,"x")
  23059   "RTN","RCD PLPL3",161 ,0)
  23060    .   I $E( $G(RCSTATU S))'="A" D
  23061   "RTN","RCD PLPL3",162 ,0)
  23062    .   .   W  !,"Since  the FMS ca sh receipt  document  is NOT Acc epted in F MS, you ca n use"
  23063   "RTN","RCD PLPL3",163 ,0)
  23064    .   .   W  !,"the op tion Proce ss Receipt  located u nder the R eceipt Pro cessing Me nu"
  23065   "RTN","RCD PLPL3",164 ,0)
  23066    .   .   W  !,"to reg enerate th e cash rec eipt docum ent to FMS .",!
  23067   "RTN","RCD PLPL3",165 ,0)
  23068    .   S VAL MSG="Payme nt linked  and remove d from lis t."
  23069   "RTN","RCD PLPL3",166 ,0)
  23070    .   D WRI TE^RCDPRPL U(VALMSG)
  23071   "RTN","RCD PLPL3",167 ,0)
  23072    ;
  23073   "RTN","RCD PLPL3",168 ,0)
  23074    ;  receip t has not  been proce ssed
  23075   "RTN","RCD PLPL3",169 ,0)
  23076    I RCGECSC R="" D
  23077   "RTN","RCD PLPL3",170 ,0)
  23078    .   S VAL MSG="Since  the recei pt has not  been proc essed, acc ounts will  not be up dated."
  23079   "RTN","RCD PLPL3",171 ,0)
  23080    .   D WRI TE^RCDPRPL U(VALMSG)
  23081   "RTN","RCD PLPL3",172 ,0)
  23082    .   S VAL MSG="Payme nt linked  and remove d from lis t."
  23083   "RTN","RCD PLPL3",173 ,0)
  23084    .   ; Upd ate EEOB c laim numbe r and rest ore to act ive status  - PRCA*4. 5*321
  23085   "RTN","RCD PLPL3",174 ,0)
  23086    .   D:RCE EOB RESTOR E^RCDPEM5( RCRECTDA,R CTRANDA,RC EEOB,"L")
  23087   "RTN","RCD PLPL3",175 ,0)
  23088    ;
  23089   "RTN","RCD PLPL3",176 ,0)
  23090   QUIT ;  ca ll here to  unlock an d rebuild  list
  23091   "RTN","RCD PLPL3",177 ,0)
  23092    L -^RCY(3 44,RCRECTD A)
  23093   "RTN","RCD PLPL3",178 ,0)
  23094    D INIT^RC DPLPLM
  23095   "RTN","RCD PLPL3",179 ,0)
  23096    Q
  23097   "RTN","RCD PLPL3",180 ,0)
  23098    ;
  23099   "RTN","RCD PLPL3",181 ,0)
  23100    ;
  23101   "RTN","RCD PLPL3",182 ,0)
  23102   SHOWPAY(RC RECTDA,RCT RANDA) ;   show the p ayment tra nsaction
  23103   "RTN","RCD PLPL3",183 ,0)
  23104    N A,D0,DA ,DIC,DIQ,D K,DL,DX,S, Y
  23105   "RTN","RCD PLPL3",184 ,0)
  23106    S DIC="^R CY(344,"_R CRECTDA_", 1,",DA(1)= RCRECTDA,D A=RCTRANDA ,DIQ(0)="C "
  23107   "RTN","RCD PLPL3",185 ,0)
  23108    D EN^DIQ
  23109   "RTN","RCD PLPL3",186 ,0)
  23110    Q
  23111   "RTN","RCD PLPL3",187 ,0)
  23112    ;
  23113   "RTN","RCD PLPL3",188 ,0)
  23114    ;
  23115   "RTN","RCD PLPL3",189 ,0)
  23116   ASKACCT()  ; ask if i ts the cor rect accou nt
  23117   "RTN","RCD PLPL3",190 ,0)
  23118    ;  1 is y es, otherw ise no
  23119   "RTN","RCD PLPL3",191 ,0)
  23120    N DIR,DIQ 2,DTOUT,DU OUT,X,Y
  23121   "RTN","RCD PLPL3",192 ,0)
  23122    S DIR(0)= "YO",DIR(" B")="NO"
  23123   "RTN","RCD PLPL3",193 ,0)
  23124    S DIR("A" )="  Is th is the cor rect ACCOU NT to appl y the paym ent to"
  23125   "RTN","RCD PLPL3",194 ,0)
  23126    D ^DIR
  23127   "RTN","RCD PLPL3",195 ,0)
  23128    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  23129   "RTN","RCD PLPL3",196 ,0)
  23130    Q Y
  23131   "RTN","RCD PLPL4")
  23132   0^37^B2487 09221
  23133   "RTN","RCD PLPL4",1,0 )
  23134   RCDPLPL4 ; ALB/SAB -  Multiple B ill Link P ayments ;1 7 Mar 16
  23135   "RTN","RCD PLPL4",2,0 )
  23136    ;;4.5;Acc ounts Rece ivable;**3 04,301,321 ,326,332** ;Mar 20, 1 995;Build  34
  23137   "RTN","RCD PLPL4",3,0 )
  23138    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  23139   "RTN","RCD PLPL4",4,0 )
  23140    ;
  23141   "RTN","RCD PLPL4",5,0 )
  23142    Q
  23143   "RTN","RCD PLPL4",6,0 )
  23144    ;
  23145   "RTN","RCD PLPL4",7,0 )
  23146   MULTIPLE(R CRECTDA,RC TRANDA,RCG ECSCR,RCST ATUS) ; Pr ocess mult iple bills  for the s ame receip t transact ion.
  23147   "RTN","RCD PLPL4",8,0 )
  23148    ;
  23149   "RTN","RCD PLPL4",9,0 )
  23150    N RCAMT,R CCT,RCAMTR M,RCEXIT,R CMSG,RCNWT RAN,RCTACC T,RCTAMT,R CTDATA,RCA CT,RCARRAY ,RCEXT,RCR SP,RCSPRSS
  23151   "RTN","RCD PLPL4",10, 0)
  23152    N RCDACNO ,I,RCNM,RC BLIEN,RCDA CNOI,RCUNA PN,RCQTSP, RCANS,RCDA CT,RCDATA, RCPIEN,RCT ACCTT
  23153   "RTN","RCD PLPL4",11, 0)
  23154    N RCTAMT, RCTCMT,RCT DNM,RCUNRC N,RCDCHKSW ,HRCDCKSW
  23155   "RTN","RCD PLPL4",12, 0)
  23156    ;
  23157   "RTN","RCD PLPL4",13, 0)
  23158    S (RCSPRS S,RCEXIT,R CCT)=0
  23159   "RTN","RCD PLPL4",14, 0)
  23160    S RCTDATA =$G(^RCY(3 44,RCRECTD A,1,RCTRAN DA,0))
  23161   "RTN","RCD PLPL4",15, 0)
  23162    I RCTDATA ="" D  Q
  23163   "RTN","RCD PLPL4",16, 0)
  23164    .  S RCMS G="The ini tial recei pt transac tion data  is missing .  Unable  to link a  claim to t his transa ction."
  23165   "RTN","RCD PLPL4",17, 0)
  23166    .  D WRIT E^RCDPRPLU (RCMSG)
  23167   "RTN","RCD PLPL4",18, 0)
  23168    ;
  23169   "RTN","RCD PLPL4",19, 0)
  23170    ; Retriev e payment  amount on  the transa ction
  23171   "RTN","RCD PLPL4",20, 0)
  23172    S (RCAMT, RCAMTRM)=+ $P(RCTDATA ,U,4)
  23173   "RTN","RCD PLPL4",21, 0)
  23174    ;
  23175   "RTN","RCD PLPL4",22, 0)
  23176    I RCAMT=0  D  Q
  23177   "RTN","RCD PLPL4",23, 0)
  23178    .  S RCMS G="The tra nsaction b alance is  0.  Unable  to link a  claim to  this trans action."
  23179   "RTN","RCD PLPL4",24, 0)
  23180    .  D WRIT E^RCDPRPLU (RCMSG)
  23181   "RTN","RCD PLPL4",25, 0)
  23182    ;
  23183   "RTN","RCD PLPL4",26, 0)
  23184    ;Retrieve  list of B ills to li nk to paym ent
  23185   "RTN","RCD PLPL4",27, 0)
  23186    F  D  Q:R CAMTRM=0   Q:RCEXIT
  23187   "RTN","RCD PLPL4",28, 0)
  23188    . ;
  23189   "RTN","RCD PLPL4",29, 0)
  23190    . ;Re-ini t the susp ense quit  flag
  23191   "RTN","RCD PLPL4",30, 0)
  23192    . S RCQTS P=0
  23193   "RTN","RCD PLPL4",31, 0)
  23194    . ;
  23195   "RTN","RCD PLPL4",32, 0)
  23196    . ;Ask th e user for  the accou nt
  23197   "RTN","RCD PLPL4",33, 0)
  23198    . S RCDCH KSW=1,HRCD CKSW=0,RCA CCT=$$GETA CCT(RCRECT DA) I RCDC HKSW=0 W !  Q    ;prc a*4.5*301
  23199   "RTN","RCD PLPL4",34, 0)
  23200    . I RCACC T=-1 D  Q
  23201   "RTN","RCD PLPL4",35, 0)
  23202    . . S RCR SP=$$CONQU IT()
  23203   "RTN","RCD PLPL4",36, 0)
  23204    . . S:RCR SP=1 RCEXI T=1
  23205   "RTN","RCD PLPL4",37, 0)
  23206    . ;
  23207   "RTN","RCD PLPL4",38, 0)
  23208    . I RCACC T=0 D  Q
  23209   "RTN","RCD PLPL4",39, 0)
  23210    . . W !,? 6,"Invalid  Bill Numb er, Please  try again ...."
  23211   "RTN","RCD PLPL4",40, 0)
  23212    . S:RCACC T="SUSPENS E" RCACCT= ""     ;Pa yment need s to remai n in suspe nse.
  23213   "RTN","RCD PLPL4",41, 0)
  23214    . ;
  23215   "RTN","RCD PLPL4",42, 0)
  23216    . ;Ask th e user for  the amoun t
  23217   "RTN","RCD PLPL4",43, 0)
  23218    . S RCAMT =$$GETAMT( RCACCT,RCA MTRM)
  23219   "RTN","RCD PLPL4",44, 0)
  23220    . Q:RCAMT =-1
  23221   "RTN","RCD PLPL4",45, 0)
  23222    . ;
  23223   "RTN","RCD PLPL4",46, 0)
  23224    . ;Ask th e user for  Comment i f no accou nt is ente red.
  23225   "RTN","RCD PLPL4",47, 0)
  23226    . S RCCMT =""
  23227   "RTN","RCD PLPL4",48, 0)
  23228    . I RCACC T="" S RCC MT=$$GETCM T()
  23229   "RTN","RCD PLPL4",49, 0)
  23230    . ;timed  out or ^ -  exit.
  23231   "RTN","RCD PLPL4",50, 0)
  23232    . I (RCCM T=-1)!(RCC MT="^") Q
  23233   "RTN","RCD PLPL4",51, 0)
  23234    . ;
  23235   "RTN","RCD PLPL4",52, 0)
  23236    . ;Update  the array  and amoun t remainin g.
  23237   "RTN","RCD PLPL4",53, 0)
  23238    . S RCCT= RCCT+1
  23239   "RTN","RCD PLPL4",54, 0)
  23240    . S RCARR AY(RCCT)=R CACCT_U_RC AMT_U_RCCM T_U_$$GETA CTNM(RCACC T)
  23241   "RTN","RCD PLPL4",55, 0)
  23242    . S RCAMT RM=RCAMTRM -RCAMT
  23243   "RTN","RCD PLPL4",56, 0)
  23244    . ;
  23245   "RTN","RCD PLPL4",57, 0)
  23246    . ;Check  to see if  user wishe s to conti nue
  23247   "RTN","RCD PLPL4",58, 0)
  23248    . I RCAMT RM>0 D
  23249   "RTN","RCD PLPL4",59, 0)
  23250    . . ;
  23251   "RTN","RCD PLPL4",60, 0)
  23252    . . ;ask  if user wi shes to co ntinue
  23253   "RTN","RCD PLPL4",61, 0)
  23254    . . S RCR SP=$$CONTI NUE(RCAMTR M)
  23255   "RTN","RCD PLPL4",62, 0)
  23256    . . ;
  23257   "RTN","RCD PLPL4",63, 0)
  23258    . . ;User  wishes to  continue
  23259   "RTN","RCD PLPL4",64, 0)
  23260    . . Q:RCR SP=1
  23261   "RTN","RCD PLPL4",65, 0)
  23262    . . ;
  23263   "RTN","RCD PLPL4",66, 0)
  23264    . . ;if n o, ask if  user is su re and tha t all sele cted payme nts will n ot be link ed.
  23265   "RTN","RCD PLPL4",67, 0)
  23266    . . S RCR SP=$$CONQU IT()
  23267   "RTN","RCD PLPL4",68, 0)
  23268    . . I RCR SP=1 S RCE XIT=1
  23269   "RTN","RCD PLPL4",69, 0)
  23270    ;
  23271   "RTN","RCD PLPL4",70, 0)
  23272    ; If the  user is ex iting befo re complet ion, quit.
  23273   "RTN","RCD PLPL4",71, 0)
  23274    Q:RCEXIT
  23275   "RTN","RCD PLPL4",72, 0)
  23276    ;
  23277   "RTN","RCD PLPL4",73, 0)
  23278    ;State al l money is  disbursed  and displ ay all acc ounts for  confirmati on
  23279   "RTN","RCD PLPL4",74, 0)
  23280    W !!,"***  RECEIPT H AS BEEN FU LLY DISBUR SED ***",!
  23281   "RTN","RCD PLPL4",75, 0)
  23282    ;
  23283   "RTN","RCD PLPL4",76, 0)
  23284    ; Ask if  user wishe s to revie w the list  again
  23285   "RTN","RCD PLPL4",77, 0)
  23286    S RCANS=$ $GETANS(1)
  23287   "RTN","RCD PLPL4",78, 0)
  23288    ;
  23289   "RTN","RCD PLPL4",79, 0)
  23290    ;Spacing  line
  23291   "RTN","RCD PLPL4",80, 0)
  23292    W !
  23293   "RTN","RCD PLPL4",81, 0)
  23294    ;
  23295   "RTN","RCD PLPL4",82, 0)
  23296    ; Review  the list i f necessar y
  23297   "RTN","RCD PLPL4",83, 0)
  23298    I RCANS=1  D
  23299   "RTN","RCD PLPL4",84, 0)
  23300    . S I=0
  23301   "RTN","RCD PLPL4",85, 0)
  23302    . W !,?5, "PATIENT N AME",?36," ACCOUNT",? 50,"PAYMEN T TO APPLY ",!
  23303   "RTN","RCD PLPL4",86, 0)
  23304    . F I=1:1 :RCCT D
  23305   "RTN","RCD PLPL4",87, 0)
  23306    . . S (RC NM,RCDACNO ,RCDACNOI) =""
  23307   "RTN","RCD PLPL4",88, 0)
  23308    . . S RCD ATA=$G(RCA RRAY(I))
  23309   "RTN","RCD PLPL4",89, 0)
  23310    . . S RCD ACT=$P(RCD ATA,U)
  23311   "RTN","RCD PLPL4",90, 0)
  23312    . . S:RCD ACT="" RCN M="SUSPENS E"
  23313   "RTN","RCD PLPL4",91, 0)
  23314    . . I RCD ACT[";DPT"  D
  23315   "RTN","RCD PLPL4",92, 0)
  23316    . . . S R CNM=$P($G( ^DPT($P(RC DACT,";"), 0)),U)
  23317   "RTN","RCD PLPL4",93, 0)
  23318    . . . S R CDACNO=""
  23319   "RTN","RCD PLPL4",94, 0)
  23320    . . I RCD ACT[";PRCA " D
  23321   "RTN","RCD PLPL4",95, 0)
  23322    . . . S R CDACNOI=$P (RCDACT,"; ")
  23323   "RTN","RCD PLPL4",96, 0)
  23324    . . . S R CDACNO=$P( $G(^PRCA(4 30,$P(RCDA CNOI,U),0) ),U)
  23325   "RTN","RCD PLPL4",97, 0)
  23326    . . . S R CPIEN=$P($ G(^DGCR(39 9,RCDACNOI ,0)),U,2)
  23327   "RTN","RCD PLPL4",98, 0)
  23328    . . . I R CPIEN="" S  RCNM="PAT IENT NAME  NOT FOUND"  Q
  23329   "RTN","RCD PLPL4",99, 0)
  23330    . . . S R CNM=$P($G( ^DPT(RCPIE N,0)),U)
  23331   "RTN","RCD PLPL4",100 ,0)
  23332    . . . I R CNM="" S R CNM="PATIE NT NAME NO T FOUND"
  23333   "RTN","RCD PLPL4",101 ,0)
  23334    . . W ?5, RCNM,?36,R CDACNO,?50 ,"$",$J($F N($P(RCDAT A,U,2),"," ,2),15),!
  23335   "RTN","RCD PLPL4",102 ,0)
  23336    ;
  23337   "RTN","RCD PLPL4",103 ,0)
  23338    ; Ask the  user if t hey wish t o update.   Quit if t hey time o ut, "^" ou t, or say  No to upda ting.
  23339   "RTN","RCD PLPL4",104 ,0)
  23340    S RCANS=$ $GETANS(2)
  23341   "RTN","RCD PLPL4",105 ,0)
  23342    Q:RCANS'= 1
  23343   "RTN","RCD PLPL4",106 ,0)
  23344    ;
  23345   "RTN","RCD PLPL4",107 ,0)
  23346    ;Initiali ze error f lag
  23347   "RTN","RCD PLPL4",108 ,0)
  23348    S RCERROR =0
  23349   "RTN","RCD PLPL4",109 ,0)
  23350    ;
  23351   "RTN","RCD PLPL4",110 ,0)
  23352    ;Surpress  PNORBILL^ RCDPURED o utput
  23353   "RTN","RCD PLPL4",111 ,0)
  23354    S RCSPRSS =1
  23355   "RTN","RCD PLPL4",112 ,0)
  23356    ;
  23357   "RTN","RCD PLPL4",113 ,0)
  23358    ;create l ine spacin g
  23359   "RTN","RCD PLPL4",114 ,0)
  23360    W !!
  23361   "RTN","RCD PLPL4",115 ,0)
  23362    ;
  23363   "RTN","RCD PLPL4",116 ,0)
  23364    ;Link the  payments
  23365   "RTN","RCD PLPL4",117 ,0)
  23366    F RCACT=1 :1:RCCT D   Q:RCERROR
  23367   "RTN","RCD PLPL4",118 ,0)
  23368    . ;
  23369   "RTN","RCD PLPL4",119 ,0)
  23370    . ;Extrac t data to  update
  23371   "RTN","RCD PLPL4",120 ,0)
  23372    . S RCTAM T=$P(RCARR AY(RCACT), U,2)   ;Pa yment Amou nt
  23373   "RTN","RCD PLPL4",121 ,0)
  23374    . S RCTAC CT=$P(RCAR RAY(RCACT) ,U,1)    ; Account to  link to.
  23375   "RTN","RCD PLPL4",122 ,0)
  23376    . S RCTCM T=$P(RCARR AY(RCACT), U,3)
  23377   "RTN","RCD PLPL4",123 ,0)
  23378    . S RCTDN M=$P(RCARR AY(RCACT), U,4)
  23379   "RTN","RCD PLPL4",124 ,0)
  23380    . S RCTAC CTT=$S(RCT ACCT="":"t he Suspens e Item",1: RCTACCT)
  23381   "RTN","RCD PLPL4",125 ,0)
  23382    . ;
  23383   "RTN","RCD PLPL4",126 ,0)
  23384    . ;If not  the first  transacti on, create  a new one
  23385   "RTN","RCD PLPL4",127 ,0)
  23386    . I RCACT '=1 D  Q
  23387   "RTN","RCD PLPL4",128 ,0)
  23388    . . ;
  23389   "RTN","RCD PLPL4",129 ,0)
  23390    . . ; Cre ate new tr ansaction
  23391   "RTN","RCD PLPL4",130 ,0)
  23392    . . S RCN WTRAN=$$CO PYTRAN(RCR ECTDA,RCTD ATA,RCTAMT ,RCGECSCR)
  23393   "RTN","RCD PLPL4",131 ,0)
  23394    . . ;
  23395   "RTN","RCD PLPL4",132 ,0)
  23396    . . ; Lin k the Paym ent using  the displa y name
  23397   "RTN","RCD PLPL4",133 ,0)
  23398    . . D LIN KPAY(RCREC TDA,RCNWTR AN,RCTDNM)
  23399   "RTN","RCD PLPL4",134 ,0)
  23400    . . ;
  23401   "RTN","RCD PLPL4",135 ,0)
  23402    . . ; bui ld unappli ed deposit  number
  23403   "RTN","RCD PLPL4",136 ,0)
  23404    . . S RCU NRCN=$P($G (^RCY(344, RCRECTDA,0 )),U)
  23405   "RTN","RCD PLPL4",137 ,0)
  23406    . . S RCU NAPN=$S($L (RCUNRCN)> 9:$E(RCUNR CN,$L(RCUN RCN-9),$L( RCUNRCN)), 1:RCUNRCN)
  23407   "RTN","RCD PLPL4",138 ,0)
  23408    . . S RCU NAPN=RCUNA PN_$E("000 0",1,4-$L( RCNWTRAN)) _RCNWTRAN
  23409   "RTN","RCD PLPL4",139 ,0)
  23410    . . D SET UNAPP^RCDP URET(RCREC TDA,RCNWTR AN,RCUNAPN ) ; add ne w unapplie d deposit  #
  23411   "RTN","RCD PLPL4",140 ,0)
  23412    . . ;
  23413   "RTN","RCD PLPL4",141 ,0)
  23414    . . ; If  creating a  new suspe nse item,  update the  comment f ield and a udit logs
  23415   "RTN","RCD PLPL4",142 ,0)
  23416    . . I RCT CMT'="" D
  23417   "RTN","RCD PLPL4",143 ,0)
  23418    . . . ;
  23419   "RTN","RCD PLPL4",144 ,0)
  23420    . . . D U PDCMT(RCRE CTDA,RCNWT RAN,RCTCMT )  ; add c omment
  23421   "RTN","RCD PLPL4",145 ,0)
  23422    . . . I $ G(RCGECSCR )'="" D
  23423   "RTN","RCD PLPL4",146 ,0)
  23424    . . . . D  AUDIT^RCB EPAY(RCREC TDA,RCNWTR AN,"I")
  23425   "RTN","RCD PLPL4",147 ,0)
  23426    . . . . D  SUSPDIS^R CBEPAY(RCR ECTDA,RCNW TRAN,"P")
  23427   "RTN","RCD PLPL4",148 ,0)
  23428    . . . W ! ,"***** PA YMENT AMOU NT LEFT IN  SUSPENSE  = $",$J(RC TAMT,"",2) ," ... don e."
  23429   "RTN","RCD PLPL4",149 ,0)
  23430    . . ;
  23431   "RTN","RCD PLPL4",150 ,0)
  23432    . . ; If  linking an  account,  process th e linking
  23433   "RTN","RCD PLPL4",151 ,0)
  23434    . . I RCT CMT="" D
  23435   "RTN","RCD PLPL4",152 ,0)
  23436    . . . ;
  23437   "RTN","RCD PLPL4",153 ,0)
  23438    . . . ; I f the rece ipt has be en process ed, proces s the paym ent
  23439   "RTN","RCD PLPL4",154 ,0)
  23440    . . . I $ G(RCGECSCR )'="" D  Q
  23441   "RTN","RCD PLPL4",155 ,0)
  23442    . . . . W  !,RCTDNM, " - Updati ng the Lin ked Accoun t with PMT  = $",$J(R CTAMT,"",2 )," ... do ne."
  23443   "RTN","RCD PLPL4",156 ,0)
  23444    . . . . D  REMCMT(RC RECTDA,RCN WTRAN)   ;  Remove th e supense  comment.   No longer  needed.
  23445   "RTN","RCD PLPL4",157 ,0)
  23446    . . . . D  PROCESS(R CRECTDA,RC NWTRAN,RCT DNM)
  23447   "RTN","RCD PLPL4",158 ,0)
  23448    . . . ;
  23449   "RTN","RCD PLPL4",159 ,0)
  23450    . . . ; T he receipt  has not b een proces sed
  23451   "RTN","RCD PLPL4",160 ,0)
  23452    . . . W ! ,RCTDNM,"  - Receipt  has not be en process ed.  Accou nt linked  but not"
  23453   "RTN","RCD PLPL4",161 ,0)
  23454    . . . W ! ,?6,"updat ed for the  PMT = $", $J(RCTAMT, "",2)
  23455   "RTN","RCD PLPL4",162 ,0)
  23456    . ;
  23457   "RTN","RCD PLPL4",163 ,0)
  23458    . ;If thi s is the f irst trans action, ad just the p ayment amo unt to be  the amount  not split  out.
  23459   "RTN","RCD PLPL4",164 ,0)
  23460    . I RCACT =1 D
  23461   "RTN","RCD PLPL4",165 ,0)
  23462    . . ;
  23463   "RTN","RCD PLPL4",166 ,0)
  23464    . . ; Mod ify the or iginal pay ment amoun t
  23465   "RTN","RCD PLPL4",167 ,0)
  23466    . . D ADJ TRAMT(RCRE CTDA,RCTRA NDA,RCTAMT ,RCGECSCR, .RCARRAY)  ; Added RC ARRAY - PR CA*4.5*326
  23467   "RTN","RCD PLPL4",168 ,0)
  23468    . . ;
  23469   "RTN","RCD PLPL4",169 ,0)
  23470    . . ; Adj usting the  amount in  suspense,  update th e comment  field and  audit logs
  23471   "RTN","RCD PLPL4",170 ,0)
  23472    . . I RCT CMT'="" D   Q
  23473   "RTN","RCD PLPL4",171 ,0)
  23474    . . . D U PDCMT(RCRE CTDA,RCTRA NDA,RCTCMT )  ; add c omment
  23475   "RTN","RCD PLPL4",172 ,0)
  23476    . . . I $ G(RCGECSCR )'="" D
  23477   "RTN","RCD PLPL4",173 ,0)
  23478    . . . . D  AUDIT^RCB EPAY(RCREC TDA,RCTRAN DA,"I")
  23479   "RTN","RCD PLPL4",174 ,0)
  23480    . . . . D  SUSPDIS^R CBEPAY(RCR ECTDA,RCTR ANDA,"P")
  23481   "RTN","RCD PLPL4",175 ,0)
  23482    . . . W ! ,"***** PA YMENT AMOU NT LEFT IN  SUSPENSE  = $",$J(RC TAMT,"",2) ," ... don e."
  23483   "RTN","RCD PLPL4",176 ,0)
  23484    . . ;
  23485   "RTN","RCD PLPL4",177 ,0)
  23486    . . ; Lin k the Paym ent, send  account if  PRCA, Pat ient name  in Patient
  23487   "RTN","RCD PLPL4",178 ,0)
  23488    . . D LIN KPAY(RCREC TDA,RCTRAN DA,RCTDNM)
  23489   "RTN","RCD PLPL4",179 ,0)
  23490    . . ;
  23491   "RTN","RCD PLPL4",180 ,0)
  23492    . . ;Remo ve the com ment, item  is no lon ger in sus pense
  23493   "RTN","RCD PLPL4",181 ,0)
  23494    . . D REM CMT(RCRECT DA,RCTRAND A)
  23495   "RTN","RCD PLPL4",182 ,0)
  23496    . . ;
  23497   "RTN","RCD PLPL4",183 ,0)
  23498    . . ; If  the receip t has been  processed , process  the paymen t
  23499   "RTN","RCD PLPL4",184 ,0)
  23500    . . I $G( RCGECSCR)' ="" D  Q
  23501   "RTN","RCD PLPL4",185 ,0)
  23502    . . . W ! ,RCTDNM,"  - Updating  the Linke d Account  with PMT =  $",$J(RCT AMT,"",2), " ... done ."
  23503   "RTN","RCD PLPL4",186 ,0)
  23504    . . . D P ROCESS(RCR ECTDA,RCTR ANDA,RCTDN M)
  23505   "RTN","RCD PLPL4",187 ,0)
  23506    . . ;
  23507   "RTN","RCD PLPL4",188 ,0)
  23508    . . ; The  receipt h as not bee n processe d
  23509   "RTN","RCD PLPL4",189 ,0)
  23510    . . W !,R CTDNM," -  Receipt ha s not been  processed .  Account  linked bu t not"
  23511   "RTN","RCD PLPL4",190 ,0)
  23512    . . W !,? 6,"updated  for the P MT = $",$J (RCTAMT,"" ,2)
  23513   "RTN","RCD PLPL4",191 ,0)
  23514    ;
  23515   "RTN","RCD PLPL4",192 ,0)
  23516    ; PRCA*4. 5*332 - If  all money  was split  off the o riginal EE OB remove  it. 
  23517   "RTN","RCD PLPL4",193 ,0)
  23518    D CHKEOB^ RCDPEU2(RC RECTDA,RCT RANDA,.RCA RRAY)
  23519   "RTN","RCD PLPL4",194 ,0)
  23520    ;
  23521   "RTN","RCD PLPL4",195 ,0)
  23522    W !!
  23523   "RTN","RCD PLPL4",196 ,0)
  23524    ;
  23525   "RTN","RCD PLPL4",197 ,0)
  23526    D ENDMSG( RCSTATUS)
  23527   "RTN","RCD PLPL4",198 ,0)
  23528    ;
  23529   "RTN","RCD PLPL4",199 ,0)
  23530    D WRITE^R CDPRPLU("  ")
  23531   "RTN","RCD PLPL4",200 ,0)
  23532    ;
  23533   "RTN","RCD PLPL4",201 ,0)
  23534    Q
  23535   "RTN","RCD PLPL4",202 ,0)
  23536    ;
  23537   "RTN","RCD PLPL4",203 ,0)
  23538   GETACCT(RC RECTDA) ;  Ask the us er for the  account
  23539   "RTN","RCD PLPL4",204 ,0)
  23540    ;
  23541   "RTN","RCD PLPL4",205 ,0)
  23542    N X,Y,DTO UT,DUOUT,D IR,DIROUT, DIRUT,DA,R CSUSFLG,RC STAT
  23543   "RTN","RCD PLPL4",206 ,0)
  23544    ;
  23545   "RTN","RCD PLPL4",207 ,0)
  23546    S RCSUSFL G=0
  23547   "RTN","RCD PLPL4",208 ,0)
  23548    S DIR("A" )="BILL NU MBER: ",DI R(0)="FAO"
  23549   "RTN","RCD PLPL4",209 ,0)
  23550    S DIR("PR E")="I X=" "SUSPENSE" " S X=""^" ",RCSUSFLG =1"
  23551   "RTN","RCD PLPL4",210 ,0)
  23552    D ^DIR
  23553   "RTN","RCD PLPL4",211 ,0)
  23554    Q:RCSUSFL G "SUSPENS E"
  23555   "RTN","RCD PLPL4",212 ,0)
  23556    I $D(DTOU T)!$D(DUOU T)!(Y="")   Q -1
  23557   "RTN","RCD PLPL4",213 ,0)
  23558    ;
  23559   "RTN","RCD PLPL4",214 ,0)
  23560    ;Force to  all caps
  23561   "RTN","RCD PLPL4",215 ,0)
  23562    S Y=$$UP^ XLFSTR(Y)
  23563   "RTN","RCD PLPL4",216 ,0)
  23564    ;
  23565   "RTN","RCD PLPL4",217 ,0)
  23566    ; Check f or valid b ill number
  23567   "RTN","RCD PLPL4",218 ,0)
  23568    I '$O(^PR CA(430,"D" ,Y,"")) S  Y=""       ; Not a va lid bill n umber
  23569   "RTN","RCD PLPL4",219 ,0)
  23570    ;
  23571   "RTN","RCD PLPL4",220 ,0)
  23572    Q:Y="" 0    ; quit i f invalid  bill numbe r or looku p number
  23573   "RTN","RCD PLPL4",221 ,0)
  23574    ;
  23575   "RTN","RCD PLPL4",222 ,0)
  23576    S X=Y
  23577   "RTN","RCD PLPL4",223 ,0)
  23578    S DA(1)=R CRECTDA
  23579   "RTN","RCD PLPL4",224 ,0)
  23580    D PNORBIL L^RCDPURED
  23581   "RTN","RCD PLPL4",225 ,0)
  23582    ; 
  23583   "RTN","RCD PLPL4",226 ,0)
  23584    ;if this  is an acco unt, is it  active?   If not, re quest a ne w account.
  23585   "RTN","RCD PLPL4",227 ,0)
  23586    I $G(X)[" ;PRCA" D   Q:RCSTAT'= "ACTIVE" 0
  23587   "RTN","RCD PLPL4",228 ,0)
  23588    . S RCSTA T=$$GET1^D IQ(430,$P( $G(X),";") _",",8,"E" )
  23589   "RTN","RCD PLPL4",229 ,0)
  23590    . I RCSTA T'="ACTIVE ",$P($G(^R CD(340,+$P (^PRCA(430 ,$P($G(X), ";"),0),"^ ",9),0))," ^")[";DPT( " W !,"Thi s bill's s tatus is c urrently " ,RCSTAT,". ",!,"Pleas e select a  different  account."
  23591   "RTN","RCD PLPL4",230 ,0)
  23592    ;
  23593   "RTN","RCD PLPL4",231 ,0)
  23594    ;Somethin g went wro ng.  Try a gain.
  23595   "RTN","RCD PLPL4",232 ,0)
  23596    I '$D(X)  Q 0
  23597   "RTN","RCD PLPL4",233 ,0)
  23598    ;
  23599   "RTN","RCD PLPL4",234 ,0)
  23600    ; Account  found, re turn it
  23601   "RTN","RCD PLPL4",235 ,0)
  23602    Q X
  23603   "RTN","RCD PLPL4",236 ,0)
  23604    ;
  23605   "RTN","RCD PLPL4",237 ,0)
  23606   GETAMT(RCA CCT,RCAMT)  ; Ask the  user for  the amount
  23607   "RTN","RCD PLPL4",238 ,0)
  23608    ;
  23609   "RTN","RCD PLPL4",239 ,0)
  23610    N X,Y,DTO UT,DUOUT,D IR,DIROUT, DIRUT,DA,R CFLG,AMTFL G
  23611   "RTN","RCD PLPL4",240 ,0)
  23612    ;
  23613   "RTN","RCD PLPL4",241 ,0)
  23614    ;
  23615   "RTN","RCD PLPL4",242 ,0)
  23616    S RCFLG=0
  23617   "RTN","RCD PLPL4",243 ,0)
  23618    F  D  Q:R CFLG
  23619   "RTN","RCD PLPL4",244 ,0)
  23620    . S AMTFL G=1  ; Set  amount fl ag check t o 1 in cas e the acco unt is a S USPENSE ac count
  23621   "RTN","RCD PLPL4",245 ,0)
  23622    . S DIR(" A")="Amoun t to apply  to Accoun t",DIR(0)= "N^0.01:"_ $J(RCAMT," ",2)_":2"
  23623   "RTN","RCD PLPL4",246 ,0)
  23624    . D ^DIR
  23625   "RTN","RCD PLPL4",247 ,0)
  23626    . I $D(DT OUT)!$D(DU OUT)!(Y="" )  S Y=-1, RCFLG=1 Q
  23627   "RTN","RCD PLPL4",248 ,0)
  23628    . ;If not  a SUSPENS E account,  check the  balance.
  23629   "RTN","RCD PLPL4",249 ,0)
  23630    . I RCACC T'="" S AM TFLG=$$PAY CHK(RCACCT ,Y)
  23631   "RTN","RCD PLPL4",250 ,0)
  23632    . ;amount  applied i s greater  than the a mount owed .  Try aga in
  23633   "RTN","RCD PLPL4",251 ,0)
  23634    . Q:'AMTF LG
  23635   "RTN","RCD PLPL4",252 ,0)
  23636    . I +Y>0  S RCFLG=1  Q
  23637   "RTN","RCD PLPL4",253 ,0)
  23638    . S Y=0,R CFLG=1
  23639   "RTN","RCD PLPL4",254 ,0)
  23640    Q Y
  23641   "RTN","RCD PLPL4",255 ,0)
  23642    ;
  23643   "RTN","RCD PLPL4",256 ,0)
  23644   GETCMT() ;  Ask the u ser for a  comment
  23645   "RTN","RCD PLPL4",257 ,0)
  23646    ;
  23647   "RTN","RCD PLPL4",258 ,0)
  23648    N X,Y,DTO UT,DUOUT,D IR,DIROUT, DIRUT
  23649   "RTN","RCD PLPL4",259 ,0)
  23650    F  D  Q:Y '=""
  23651   "RTN","RCD PLPL4",260 ,0)
  23652    . S Y=$$C OM^RCDPECH  ; PRCA*4. 5*321
  23653   "RTN","RCD PLPL4",261 ,0)
  23654    . ;strip  all leadin g and trai ling space s
  23655   "RTN","RCD PLPL4",262 ,0)
  23656    . S Y=$$T RIM^XLFSTR (Y)
  23657   "RTN","RCD PLPL4",263 ,0)
  23658    . I Y=""  W !,"A com ment is re quired whe n changing  the statu s of an it em in Susp ense.  Ple ase",!,"tr y again."  Q
  23659   "RTN","RCD PLPL4",264 ,0)
  23660    . I $D(DT OUT) S Y=- 1
  23661   "RTN","RCD PLPL4",265 ,0)
  23662    Q Y
  23663   "RTN","RCD PLPL4",266 ,0)
  23664    ;
  23665   "RTN","RCD PLPL4",267 ,0)
  23666   CONTINUE(R CAMTRM) ;  Ask the us er to see  if they wi sh to cont inue
  23667   "RTN","RCD PLPL4",268 ,0)
  23668    ;
  23669   "RTN","RCD PLPL4",269 ,0)
  23670    N X,Y,DTO UT,DUOUT,D IR,DIROUT, DIRUT
  23671   "RTN","RCD PLPL4",270 ,0)
  23672    S DIR("A" )="Receipt  has $"_$J (RCAMTRM,1 0,2)_" lef t to link.   Do you w ish to lin k another?  ",DIR(0)= "YA"
  23673   "RTN","RCD PLPL4",271 ,0)
  23674    D ^DIR
  23675   "RTN","RCD PLPL4",272 ,0)
  23676    I $D(DTOU T)!$D(DUOU T)!(Y="")   Q -1
  23677   "RTN","RCD PLPL4",273 ,0)
  23678    Q Y
  23679   "RTN","RCD PLPL4",274 ,0)
  23680    ;
  23681   "RTN","RCD PLPL4",275 ,0)
  23682    ; Confirm  with the  user that  the wish t o stop bef ore comple ting the l inking of  payments
  23683   "RTN","RCD PLPL4",276 ,0)
  23684   CONQUIT()  ;
  23685   "RTN","RCD PLPL4",277 ,0)
  23686    ;
  23687   "RTN","RCD PLPL4",278 ,0)
  23688    N X,Y,DTO UT,DUOUT,D IR,DIROUT, DIRUT
  23689   "RTN","RCD PLPL4",279 ,0)
  23690    S DIR("A" ,1)="Exiti ng now wil l prevent  the linkin g of any p reviously  selected c laims to t his"
  23691   "RTN","RCD PLPL4",280 ,0)
  23692    S DIR("A" )="receipt .  Are you  sure? ",D IR(0)="YA"
  23693   "RTN","RCD PLPL4",281 ,0)
  23694    D ^DIR
  23695   "RTN","RCD PLPL4",282 ,0)
  23696    I $D(DTOU T)!$D(DUOU T)!(Y="")   Q 1
  23697   "RTN","RCD PLPL4",283 ,0)
  23698    Q Y
  23699   "RTN","RCD PLPL4",284 ,0)
  23700    ;
  23701   "RTN","RCD PLPL4",285 ,0)
  23702    ;Create a  new trans action usi ng an exis ting trans action as  the founda tion.
  23703   "RTN","RCD PLPL4",286 ,0)
  23704   COPYTRAN(R CRECTDA,RC TDATA,RCAM T,RCGECSCR ) ;
  23705   "RTN","RCD PLPL4",287 ,0)
  23706    ; Input 
  23707   "RTN","RCD PLPL4",288 ,0)
  23708    ;   RCREC TDA - IEN  of Receipt  file #344
  23709   "RTN","RCD PLPL4",289 ,0)
  23710    ;   RCPAY DA  - IEN  of Receipt  Transacti on file #3 44.01
  23711   "RTN","RCD PLPL4",290 ,0)
  23712    ;   RCAMT     - Amou nt
  23713   "RTN","RCD PLPL4",291 ,0)
  23714    ;   RCGEC SCR - null  = receipt  not proce ssed
  23715   "RTN","RCD PLPL4",292 ,0)
  23716    ; Output
  23717   "RTN","RCD PLPL4",293 ,0)
  23718    ;   Updat e Receipt  file #344  and Audit  log #344,7 1
  23719   "RTN","RCD PLPL4",294 ,0)
  23720    ;
  23721   "RTN","RCD PLPL4",295 ,0)
  23722    N RCNWTRA N,DR,DA,DT OUT,DIE,X, Y,RCTDATA3
  23723   "RTN","RCD PLPL4",296 ,0)
  23724    ;
  23725   "RTN","RCD PLPL4",297 ,0)
  23726    S RCTDATA 3=$G(^RCY( 344,RCRECT DA,1,RCTRA NDA,3))
  23727   "RTN","RCD PLPL4",298 ,0)
  23728    ;Create a  new trans action
  23729   "RTN","RCD PLPL4",299 ,0)
  23730    S RCNWTRA N=$$ADDTRA N^RCDPURET (RCRECTDA)
  23731   "RTN","RCD PLPL4",300 ,0)
  23732    S RCCMT=" Multi-Tran s Split"
  23733   "RTN","RCD PLPL4",301 ,0)
  23734    ;
  23735   "RTN","RCD PLPL4",302 ,0)
  23736    ;Update T ransaction
  23737   "RTN","RCD PLPL4",303 ,0)
  23738    S DR=".02 ////"_$P(R CTDATA,U,2 )       ;O riginal Co nfirmation  #
  23739   "RTN","RCD PLPL4",304 ,0)
  23740    S DR=DR_" ;.04///"_R CAMT               ;A mount
  23741   "RTN","RCD PLPL4",305 ,0)
  23742    S DR=DR_" ;.06////"_ $P(RCTDATA ,U,6)   ;O riginal da te of paym ent
  23743   "RTN","RCD PLPL4",306 ,0)
  23744    S DR=DR_" ;.07////"_ $P(RCTDATA ,U,7)   ;O riginal Ch eck #
  23745   "RTN","RCD PLPL4",307 ,0)
  23746    S DR=DR_" ;.08////"_ $P(RCTDATA ,U,8)   ;O riginal Ch eck routin g #
  23747   "RTN","RCD PLPL4",308 ,0)
  23748    S DR=DR_" ;.1////"_$ P(RCTDATA, U,10)   ;O riginal da te on the  check
  23749   "RTN","RCD PLPL4",309 ,0)
  23750    S DR=DR_" ;.11////"_ $P(RCTDATA ,U,11)  ;O riginal CC  number
  23751   "RTN","RCD PLPL4",310 ,0)
  23752    S DR=DR_" ;.12////"_ $P(RCTDATA ,U,12)  ;O riginal us er who ent ered the c heck
  23753   "RTN","RCD PLPL4",311 ,0)
  23754    S DR=DR_" ;.13////"_ $P(RCTDATA ,U,13)  ;O riginal ch eck accoun t #
  23755   "RTN","RCD PLPL4",312 ,0)
  23756    S DR=DR_" ;.14///"_D UZ                 ;U ser Linkin g the paym ent
  23757   "RTN","RCD PLPL4",313 ,0)
  23758    S DR=DR_" ;1.02////" _RCCMT             ;I nitial Com ment
  23759   "RTN","RCD PLPL4",314 ,0)
  23760    S DR=DR_" ;3.02////" _$P(RCTDAT A3,U,2) ;D ate Trans.  originall y suspense
  23761   "RTN","RCD PLPL4",315 ,0)
  23762    S DR=DR_" ;3.03////" _$P(RCTDAT A3,U,3) ;U ser who or iginally s uspended T rans.
  23763   "RTN","RCD PLPL4",316 ,0)
  23764    S DIE="^R CY(344,"_R CRECTDA_", 1,"
  23765   "RTN","RCD PLPL4",317 ,0)
  23766    S DA=RCNW TRAN,DA(1) =RCRECTDA
  23767   "RTN","RCD PLPL4",318 ,0)
  23768    D ^DIE
  23769   "RTN","RCD PLPL4",319 ,0)
  23770    S $P(^RCY (344,RCREC TDA,1,RCNW TRAN,0),"^ ",19)=$G(R CDPTYPE)
  23771   "RTN","RCD PLPL4",320 ,0)
  23772    ;
  23773   "RTN","RCD PLPL4",321 ,0)
  23774    ;Update t he Audit L og
  23775   "RTN","RCD PLPL4",322 ,0)
  23776    I $G(RCGE CSCR)'=""  D AUDIT^RC BEPAY(RCRE CTDA,RCNWT RAN,"I")
  23777   "RTN","RCD PLPL4",323 ,0)
  23778    ;
  23779   "RTN","RCD PLPL4",324 ,0)
  23780    Q RCNWTRA N
  23781   "RTN","RCD PLPL4",325 ,0)
  23782    ;
  23783   "RTN","RCD PLPL4",326 ,0)
  23784    ;Adjust t he origina l transact ion's paym ent amount  to match  to the act ual, split  amount.
  23785   "RTN","RCD PLPL4",327 ,0)
  23786   ADJTRAMT(R CRECTDA,RC TRANDA,RCA MT,RCGECSC R,RCARRAY)  ; Added R CARRAY - P RCA*4.5*32 6
  23787   "RTN","RCD PLPL4",328 ,0)
  23788    ; Input 
  23789   "RTN","RCD PLPL4",329 ,0)
  23790    ;   RCREC TDA - IEN  of Receipt  file #344
  23791   "RTN","RCD PLPL4",330 ,0)
  23792    ;   RCPAY DA  - IEN  of Receipt  Transacti on file #3 44.01
  23793   "RTN","RCD PLPL4",331 ,0)
  23794    ;   RCAMT     - Amou nt
  23795   "RTN","RCD PLPL4",332 ,0)
  23796    ;   RCGEC SCR - null  = receipt  not proce ssed
  23797   "RTN","RCD PLPL4",333 ,0)
  23798    ;   RCARR AY  - Arra y of Multi -Trans spl it informa tion (OPTI ONAL)
  23799   "RTN","RCD PLPL4",334 ,0)
  23800    ; Output
  23801   "RTN","RCD PLPL4",335 ,0)
  23802    ;   Updat e Receipt  file #344  and Audit  log #344,7 1
  23803   "RTN","RCD PLPL4",336 ,0)
  23804    ;
  23805   "RTN","RCD PLPL4",337 ,0)
  23806    N RCCMT,D R,DIE,DA,D TOUT
  23807   "RTN","RCD PLPL4",338 ,0)
  23808    S RCCMT=" Multi-Tran s Split"
  23809   "RTN","RCD PLPL4",339 ,0)
  23810    ;
  23811   "RTN","RCD PLPL4",340 ,0)
  23812    S DR=".04 ///"_RCAMT _";1.02/// "_RCCMT
  23813   "RTN","RCD PLPL4",341 ,0)
  23814    S DIE="^R CY(344,"_R CRECTDA_", 1,"
  23815   "RTN","RCD PLPL4",342 ,0)
  23816    S DA=RCTR ANDA,DA(1) =RCRECTDA
  23817   "RTN","RCD PLPL4",343 ,0)
  23818    D ^DIE
  23819   "RTN","RCD PLPL4",344 ,0)
  23820    D LASTEDI T^RCDPUREC (RCRECTDA)
  23821   "RTN","RCD PLPL4",345 ,0)
  23822    ;
  23823   "RTN","RCD PLPL4",346 ,0)
  23824    ;Update t he Audit L og
  23825   "RTN","RCD PLPL4",347 ,0)
  23826    I $G(RCGE CSCR)'=""  D AUDIT^RC BEPAY(RCRE CTDA,RCTRA NDA,"I",.R CARRAY) ;  Added RCAR RAY - PRCA *4.5*326
  23827   "RTN","RCD PLPL4",348 ,0)
  23828    ;Update c omment his tory - PRC A*4.5*321
  23829   "RTN","RCD PLPL4",349 ,0)
  23830    D AUDIT^R CDPECH(RCR ECTDA,RCTR ANDA,"","" )
  23831   "RTN","RCD PLPL4",350 ,0)
  23832    Q
  23833   "RTN","RCD PLPL4",351 ,0)
  23834    ;
  23835   "RTN","RCD PLPL4",352 ,0)
  23836    ;Link the  Transacti on to an e xisting ac count
  23837   "RTN","RCD PLPL4",353 ,0)
  23838   LINKPAY(RC RECTDA,RCT RANDA,RCAC CT) ;
  23839   "RTN","RCD PLPL4",354 ,0)
  23840    ;
  23841   "RTN","RCD PLPL4",355 ,0)
  23842    N DR,DIE, DA,DTOUT
  23843   "RTN","RCD PLPL4",356 ,0)
  23844    S DR=".09 ///"_RCACC T
  23845   "RTN","RCD PLPL4",357 ,0)
  23846    S DIE="^R CY(344,"_R CRECTDA_", 1,"
  23847   "RTN","RCD PLPL4",358 ,0)
  23848    S DA=RCTR ANDA,DA(1) =RCRECTDA
  23849   "RTN","RCD PLPL4",359 ,0)
  23850    D ^DIE
  23851   "RTN","RCD PLPL4",360 ,0)
  23852    D LASTEDI T^RCDPUREC (RCRECTDA)
  23853   "RTN","RCD PLPL4",361 ,0)
  23854    Q
  23855   "RTN","RCD PLPL4",362 ,0)
  23856    ;
  23857   "RTN","RCD PLPL4",363 ,0)
  23858    ;Remove t he suspens e comment,  item no l onger in s uspense
  23859   "RTN","RCD PLPL4",364 ,0)
  23860   REMCMT(RCR ECTDA,RCTR ANDA) ;
  23861   "RTN","RCD PLPL4",365 ,0)
  23862    ;
  23863   "RTN","RCD PLPL4",366 ,0)
  23864    N DR,DIE, DA,DTOUT
  23865   "RTN","RCD PLPL4",367 ,0)
  23866    S DR="1.0 2///@"
  23867   "RTN","RCD PLPL4",368 ,0)
  23868    S DIE="^R CY(344,"_R CRECTDA_", 1,"
  23869   "RTN","RCD PLPL4",369 ,0)
  23870    S DA=RCTR ANDA,DA(1) =RCRECTDA
  23871   "RTN","RCD PLPL4",370 ,0)
  23872    D ^DIE
  23873   "RTN","RCD PLPL4",371 ,0)
  23874    D LASTEDI T^RCDPUREC (RCRECTDA)
  23875   "RTN","RCD PLPL4",372 ,0)
  23876    Q
  23877   "RTN","RCD PLPL4",373 ,0)
  23878    ;
  23879   "RTN","RCD PLPL4",374 ,0)
  23880   GETACTNM(R CACCT) ;
  23881   "RTN","RCD PLPL4",375 ,0)
  23882    N RCACCTL ,RCIEN,RCF ILE
  23883   "RTN","RCD PLPL4",376 ,0)
  23884    S RCACCTL =""
  23885   "RTN","RCD PLPL4",377 ,0)
  23886    Q:RCACCT= "" RCACCTL
  23887   "RTN","RCD PLPL4",378 ,0)
  23888    S RCFILE= $S(RCACCT[ ";PRCA(430 ":430,1:2)
  23889   "RTN","RCD PLPL4",379 ,0)
  23890    S RCIEN=$ P(RCACCT," ;")
  23891   "RTN","RCD PLPL4",380 ,0)
  23892    S RCACCTL =$$GET1^DI Q(RCFILE,R CIEN_","," .01","E")
  23893   "RTN","RCD PLPL4",381 ,0)
  23894    S:$L(RCAC CTL,"-")>1  RCACCTL=$ P(RCACCTL, "-",2)
  23895   "RTN","RCD PLPL4",382 ,0)
  23896    Q RCACCTL
  23897   "RTN","RCD PLPL4",383 ,0)
  23898    ;
  23899   "RTN","RCD PLPL4",384 ,0)
  23900    ;Update t he suspens e comment
  23901   "RTN","RCD PLPL4",385 ,0)
  23902   UPDCMT(RCR ECTDA,RCTR ANDA,RCCMT ) ;
  23903   "RTN","RCD PLPL4",386 ,0)
  23904    ;
  23905   "RTN","RCD PLPL4",387 ,0)
  23906    N DR,DIE, DA,DTOUT
  23907   "RTN","RCD PLPL4",388 ,0)
  23908    S DR="1.0 2///"_RCCM T_";" S DI E="^RCY(34 4,"_RCRECT DA_",1,"
  23909   "RTN","RCD PLPL4",389 ,0)
  23910    S DA=RCTR ANDA,DA(1) =RCRECTDA
  23911   "RTN","RCD PLPL4",390 ,0)
  23912    D ^DIE
  23913   "RTN","RCD PLPL4",391 ,0)
  23914    ;Update c omment his tory - PRC A*4.5*321
  23915   "RTN","RCD PLPL4",392 ,0)
  23916    D AUDIT^R CDPECH(RCR ECTDA,RCTR ANDA,"","" )
  23917   "RTN","RCD PLPL4",393 ,0)
  23918    Q
  23919   "RTN","RCD PLPL4",394 ,0)
  23920    ;
  23921   "RTN","RCD PLPL4",395 ,0)
  23922    ;Process  and update  the payme nt amounts
  23923   "RTN","RCD PLPL4",396 ,0)
  23924    ;Note:  s ome of the  code and  logic belo w is also  in tag PRO CESS^RCDPL PL3.  
  23925   "RTN","RCD PLPL4",397 ,0)
  23926    ;       I f changes  in logic a re made be low, pleas e review t his tag as  well.
  23927   "RTN","RCD PLPL4",398 ,0)
  23928   PROCESS(RC RECTDA,RCT RANDA,RCTD NM) ;
  23929   "RTN","RCD PLPL4",399 ,0)
  23930    ;
  23931   "RTN","RCD PLPL4",400 ,0)
  23932    N RCERROR
  23933   "RTN","RCD PLPL4",401 ,0)
  23934    S RCERROR =$$PROCESS ^RCBEPAY(R CRECTDA,RC TRANDA)
  23935   "RTN","RCD PLPL4",402 ,0)
  23936    ;  an err or occurre d during p rocessing  a payment
  23937   "RTN","RCD PLPL4",403 ,0)
  23938    I RCERROR  D  Q
  23939   "RTN","RCD PLPL4",404 ,0)
  23940    . W !
  23941   "RTN","RCD PLPL4",405 ,0)
  23942    . W !,"+- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -------+"
  23943   "RTN","RCD PLPL4",406 ,0)
  23944    . W !,"|   An ERROR  has occurr ed when pr ocessing p ayment ",R CTRANDA,"  on receipt  ",$P(^RCY (344,RCREC TDA,0),"^" ),".",?79, "|"
  23945   "RTN","RCD PLPL4",407 ,0)
  23946    . W !,"|   The error  message r eturned du ring proce ssing is:" ,?79,"|"
  23947   "RTN","RCD PLPL4",408 ,0)
  23948    . W !,"|" ,?79,"|"
  23949   "RTN","RCD PLPL4",409 ,0)
  23950    . W !,"|   ",$P(RCER ROR,"^",2) ,?79,"|"
  23951   "RTN","RCD PLPL4",410 ,0)
  23952    . W !,"|" ,?79,"|"
  23953   "RTN","RCD PLPL4",411 ,0)
  23954    . W !,"|   You will  need to co rrect the  error befo re you can  link the  payment.", ?79,"|"
  23955   "RTN","RCD PLPL4",412 ,0)
  23956    . W !,"+- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -------+"
  23957   "RTN","RCD PLPL4",413 ,0)
  23958    . W !
  23959   "RTN","RCD PLPL4",414 ,0)
  23960    . D DELEA CCT^RCDPUR ET(RCRECTD A,RCTRANDA )
  23961   "RTN","RCD PLPL4",415 ,0)
  23962    . W !,"Ac count "_RC TDNM_" was  deleted a nd not lin ked."
  23963   "RTN","RCD PLPL4",416 ,0)
  23964    ;
  23965   "RTN","RCD PLPL4",417 ,0)
  23966    ;File ent ry in Audi t Log
  23967   "RTN","RCD PLPL4",418 ,0)
  23968    D AUDIT^R CBEPAY(RCR ECTDA,RCTR ANDA,"P")
  23969   "RTN","RCD PLPL4",419 ,0)
  23970    ;
  23971   "RTN","RCD PLPL4",420 ,0)
  23972    ; Update  Suspense S tatus
  23973   "RTN","RCD PLPL4",421 ,0)
  23974    D SUSPDIS ^RCBEPAY(R CRECTDA,RC TRANDA,"PD ")
  23975   "RTN","RCD PLPL4",422 ,0)
  23976    ;
  23977   "RTN","RCD PLPL4",423 ,0)
  23978    I $E(RCST ATUS)="A"  D
  23979   "RTN","RCD PLPL4",424 ,0)
  23980    . ;  send  mail mess age to the  RCDP PAYM ENTS mail  group
  23981   "RTN","RCD PLPL4",425 ,0)
  23982    . D MAILM SG^RCDPLPS R(RCRECTDA ,RCTRANDA)
  23983   "RTN","RCD PLPL4",426 ,0)
  23984    . ;  plac e an x in  the fms do c field so  it will s how on the
  23985   "RTN","RCD PLPL4",427 ,0)
  23986    . ;  susp ense repor t
  23987   "RTN","RCD PLPL4",428 ,0)
  23988    . D EDITF MS^RCDPURE T(RCRECTDA ,RCTRANDA, "x")
  23989   "RTN","RCD PLPL4",429 ,0)
  23990    Q
  23991   "RTN","RCD PLPL4",430 ,0)
  23992    ;
  23993   "RTN","RCD PLPL4",431 ,0)
  23994    ;Display  end of pro cessing me ssage.
  23995   "RTN","RCD PLPL4",432 ,0)
  23996   ENDMSG(RCS TATUS) ;
  23997   "RTN","RCD PLPL4",433 ,0)
  23998    ;
  23999   "RTN","RCD PLPL4",434 ,0)
  24000    I $E(RCST ATUS)="A"  D
  24001   "RTN","RCD PLPL4",435 ,0)
  24002    . W !,"Si nce the FM S cash rec eipt docum ent is Acc epted in F MS, you ne ed to go"
  24003   "RTN","RCD PLPL4",436 ,0)
  24004    . W !,"on line in FM S and tran sfer the a mount paid  out of th e station' s suspense "
  24005   "RTN","RCD PLPL4",437 ,0)
  24006    . W !,"ac count.",!
  24007   "RTN","RCD PLPL4",438 ,0)
  24008    . W !,"Ma il message (s) sent t o RCDP PAY MENTS mail  group.",!
  24009   "RTN","RCD PLPL4",439 ,0)
  24010    I $E(RCST ATUS)'="A"  D
  24011   "RTN","RCD PLPL4",440 ,0)
  24012    . W !,"Si nce the FM S cash rec eipt docum ent is NOT  Accepted  in FMS, yo u can use"
  24013   "RTN","RCD PLPL4",441 ,0)
  24014    . W !,"th e option P rocess Rec eipt locat ed under t he Receipt  Processin g Menu"
  24015   "RTN","RCD PLPL4",442 ,0)
  24016    . W !,"to  regenerat e the cash  receipt d ocument to  FMS.",!
  24017   "RTN","RCD PLPL4",443 ,0)
  24018    Q
  24019   "RTN","RCD PLPL4",444 ,0)
  24020    ;
  24021   "RTN","RCD PLPL4",445 ,0)
  24022    ;Get user s answers  to questio ns for rep orts.
  24023   "RTN","RCD PLPL4",446 ,0)
  24024   GETANS(RCI DX) ;
  24025   "RTN","RCD PLPL4",447 ,0)
  24026    N DA,DIR, DTOUT,DUOU T,X,Y,DIRU T,DIROUT
  24027   "RTN","RCD PLPL4",448 ,0)
  24028    ;
  24029   "RTN","RCD PLPL4",449 ,0)
  24030    ; Ask the  user what  kind of r eport
  24031   "RTN","RCD PLPL4",450 ,0)
  24032    I RCIDX=1  D
  24033   "RTN","RCD PLPL4",451 ,0)
  24034    . S DIR(" ?")="Selec t to Y to  review the  payments,  N to skip  the revie w."
  24035   "RTN","RCD PLPL4",452 ,0)
  24036    . S DIR(" A")="Do yo u want to  review the  payment l ist before  updating  accounts ( Y/N)? "
  24037   "RTN","RCD PLPL4",453 ,0)
  24038    ;
  24039   "RTN","RCD PLPL4",454 ,0)
  24040    ; Ask the  user for  the payer  to start t he reporti ng on (Ran ge Option)
  24041   "RTN","RCD PLPL4",455 ,0)
  24042    I RCIDX=2  D
  24043   "RTN","RCD PLPL4",456 ,0)
  24044    . S DIR(" ?")="Enter  Y to upda te the acc ounts, N t o return t o the LP m enu"
  24045   "RTN","RCD PLPL4",457 ,0)
  24046    . S DIR(" A")="Do yo u want to  update acc ounts with  these pay ments (Y/N )? "
  24047   "RTN","RCD PLPL4",458 ,0)
  24048    ;
  24049   "RTN","RCD PLPL4",459 ,0)
  24050    S DIR(0)= "YA"
  24051   "RTN","RCD PLPL4",460 ,0)
  24052    D ^DIR
  24053   "RTN","RCD PLPL4",461 ,0)
  24054    K DIR
  24055   "RTN","RCD PLPL4",462 ,0)
  24056    I $G(DTOU T)!$G(DUOU T) Q -1
  24057   "RTN","RCD PLPL4",463 ,0)
  24058    Q Y
  24059   "RTN","RCD PLPL4",464 ,0)
  24060    ;
  24061   "RTN","RCD PLPL4",465 ,0)
  24062    ;Retrieve  the revie w response  question  from the u ser
  24063   "RTN","RCD PLPL4",466 ,0)
  24064   GETANS1()  ;
  24065   "RTN","RCD PLPL4",467 ,0)
  24066    ;
  24067   "RTN","RCD PLPL4",468 ,0)
  24068    N FLG,X,Y
  24069   "RTN","RCD PLPL4",469 ,0)
  24070    S FLG=0,Y =0
  24071   "RTN","RCD PLPL4",470 ,0)
  24072    F  D  Q:F LG=1
  24073   "RTN","RCD PLPL4",471 ,0)
  24074    . R !,"Do  you want  to review  the paymen t list bef ore updati ng account s (Y/N)? " ,X:DTIME
  24075   "RTN","RCD PLPL4",472 ,0)
  24076    . ;I $G(D TOUT) S FL G=1 Q    ; If it time s out, tre at it like  a No and  go to the  next promp t.
  24077   "RTN","RCD PLPL4",473 ,0)
  24078    . I X=""  W !,"Enter  Y or N to  continue. " Q
  24079   "RTN","RCD PLPL4",474 ,0)
  24080    . I X["?"  W !,"Sele ct to Y to  review th e payments , N to ski p the revi ew." Q
  24081   "RTN","RCD PLPL4",475 ,0)
  24082    . S X=$$U P^XLFSTR(X )
  24083   "RTN","RCD PLPL4",476 ,0)
  24084    . I X="Y"  S Y=1,FLG =1 Q
  24085   "RTN","RCD PLPL4",477 ,0)
  24086    . I X="N"  S Y=0,FLG =1 Q
  24087   "RTN","RCD PLPL4",478 ,0)
  24088    . W !,"Se lect to Y  to review  the paymen ts, N to s kip the re view."
  24089   "RTN","RCD PLPL4",479 ,0)
  24090    Q Y
  24091   "RTN","RCD PLPL4",480 ,0)
  24092    ;
  24093   "RTN","RCD PLPL4",481 ,0)
  24094    ;Is the a mount ente red < the  amount owe d. (AR ACC OUNTS ONLY , NO DEBTO RS)
  24095   "RTN","RCD PLPL4",482 ,0)
  24096   PAYCHK(RCA CCT,RCAMT)  ;
  24097   "RTN","RCD PLPL4",483 ,0)
  24098    ;
  24099   "RTN","RCD PLPL4",484 ,0)
  24100    N OWED,FL G
  24101   "RTN","RCD PLPL4",485 ,0)
  24102    ;
  24103   "RTN","RCD PLPL4",486 ,0)
  24104    S FLG=0
  24105   "RTN","RCD PLPL4",487 ,0)
  24106    ; account  is the de btor accou nt. No nee d to check ...
  24107   "RTN","RCD PLPL4",488 ,0)
  24108    Q:RCACCT' ["PRCA" 1
  24109   "RTN","RCD PLPL4",489 ,0)
  24110    ;  calcul ate amount  owed for  a bill
  24111   "RTN","RCD PLPL4",490 ,0)
  24112    S OWED=$G (^PRCA(430 ,+RCACCT,7 ))
  24113   "RTN","RCD PLPL4",491 ,0)
  24114    S OWED=$P (OWED,"^") +$P(OWED," ^",2)+$P(O WED,"^",3) +$P(OWED," ^",4)+$P(O WED,"^",5)
  24115   "RTN","RCD PLPL4",492 ,0)
  24116    I RCAMT>O WED W !,"T he request ed payment  is greate r than the n amount o wed please  try again .",! Q FLG
  24117   "RTN","RCD PLPL4",493 ,0)
  24118    S FLG=1
  24119   "RTN","RCD PLPL4",494 ,0)
  24120    Q FLG
  24121   "RTN","RCD PRLIS")
  24122   0^11^B1436 35402
  24123   "RTN","RCD PRLIS",1,0 )
  24124   RCDPRLIS ; WISC/RFJ -  list of r eceipts re port ;1 Ju n 99
  24125   "RTN","RCD PRLIS",2,0 )
  24126    ;;4.5;Acc ounts Rece ivable;**1 14,304,321 ,332**;Mar  20, 1995; Build 34
  24127   "RTN","RCD PRLIS",3,0 )
  24128    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  24129   "RTN","RCD PRLIS",4,0 )
  24130    ;
  24131   "RTN","RCD PRLIS",5,0 )
  24132    N %ZIS,DA TEEND,DATE STRT,POP,R CFILTF,RCF ILTT,RCLST MGR,RCSORT
  24133   "RTN","RCD PRLIS",6,0 )
  24134    N ZTDESC, ZTQUEUED,Z TRTN,ZTSAV E,ZTSK
  24135   "RTN","RCD PRLIS",7,0 )
  24136    W !
  24137   "RTN","RCD PRLIS",8,0 )
  24138    D DATESEL ^RCRJRTRA( "RECEIPT O pened")
  24139   "RTN","RCD PRLIS",9,0 )
  24140    I '$G(DAT ESTRT)!('$ G(DATEEND) ) Q
  24141   "RTN","RCD PRLIS",10, 0)
  24142    ;
  24143   "RTN","RCD PRLIS",11, 0)
  24144    ; Prompt  for sort o rder PRCA* 4.5*321
  24145   "RTN","RCD PRLIS",12, 0)
  24146    S RCSORT= $$SORTSEL( )
  24147   "RTN","RCD PRLIS",13, 0)
  24148    I RCSORT= -1 Q
  24149   "RTN","RCD PRLIS",14, 0)
  24150    ;
  24151   "RTN","RCD PRLIS",15, 0)
  24152    ; Prompt  for filter  by FMS St atus PRCA* 4.5*321
  24153   "RTN","RCD PRLIS",16, 0)
  24154    D SELFILT F(.RCFILTF )
  24155   "RTN","RCD PRLIS",17, 0)
  24156    I RCFILTF =-1 Q
  24157   "RTN","RCD PRLIS",18, 0)
  24158    ;
  24159   "RTN","RCD PRLIS",19, 0)
  24160    ; Prompt  for filter  by Paymen t Type PRC A*4.5*321
  24161   "RTN","RCD PRLIS",20, 0)
  24162    D SELFILT T(.RCFILTT )
  24163   "RTN","RCD PRLIS",21, 0)
  24164    I RCFILTT =-1 Q
  24165   "RTN","RCD PRLIS",22, 0)
  24166    ;
  24167   "RTN","RCD PRLIS",23, 0)
  24168    ; Ask for  ListMan d isplay, ex it if time out or '^'
  24169   "RTN","RCD PRLIS",24, 0)
  24170    W !
  24171   "RTN","RCD PRLIS",25, 0)
  24172    S RCLSTMG R=$$ASKLM^ RCDPEARL()  I RCLSTMG R<0 Q
  24173   "RTN","RCD PRLIS",26, 0)
  24174    ;
  24175   "RTN","RCD PRLIS",27, 0)
  24176    ; Send re port to Li stman if r equested
  24177   "RTN","RCD PRLIS",28, 0)
  24178    I RCLSTMG R D  D CLE AN Q
  24179   "RTN","RCD PRLIS",29, 0)
  24180    . D DQ
  24181   "RTN","RCD PRLIS",30, 0)
  24182    . D EN^RC DPRL
  24183   "RTN","RCD PRLIS",31, 0)
  24184    ;
  24185   "RTN","RCD PRLIS",32, 0)
  24186    ;  select  device
  24187   "RTN","RCD PRLIS",33, 0)
  24188    W ! S %ZI S="Q" D ^% ZIS I POP  Q
  24189   "RTN","RCD PRLIS",34, 0)
  24190    I $D(IO(" Q")) D  D  ^%ZTLOAD K  IO("Q"),Z TSK Q
  24191   "RTN","RCD PRLIS",35, 0)
  24192    .   S ZTD ESC="List  of Receipt s",ZTRTN=" DQ^RCDPRLI S"
  24193   "RTN","RCD PRLIS",36, 0)
  24194    .   S ZTS AVE("DATE* ")="",ZTSA VE("RC*")= "",ZTSAVE( "ZTREQ")=" @"
  24195   "RTN","RCD PRLIS",37, 0)
  24196    W !!,"<*>  please wa it <*>"
  24197   "RTN","RCD PRLIS",38, 0)
  24198    D DQ
  24199   "RTN","RCD PRLIS",39, 0)
  24200    Q
  24201   "RTN","RCD PRLIS",40, 0)
  24202    ;
  24203   "RTN","RCD PRLIS",41, 0)
  24204   DQ ;  queu ed report  starts her e
  24205   "RTN","RCD PRLIS",42, 0)
  24206    ; PRCA*4. 5*321 Exte nsive chan ges to thi s subrouti ne for fil ter/sort/L istMan
  24207   "RTN","RCD PRLIS",43, 0)
  24208    N %,%I,CN T,DATA,DAT E,DATEDIS1 ,DATEDIS2, FMSDOCNO,F MSTATUS,NO W,PAGE,PTY PE,RCDK,RC DPDATA
  24209   "RTN","RCD PRLIS",44, 0)
  24210    N RCDPFPR E,RCIX,RCR ECTDA,RCRJ FLAG,RCRJL INE,RCUSER ,SCREEN,SP ACE,TOTALS ,TYPE,X,XX ,Y,ZZ ; PR CA*4.5*332
  24211   "RTN","RCD PRLIS",45, 0)
  24212    K ^TMP($J ,"RCDPRLIS ")
  24213   "RTN","RCD PRLIS",46, 0)
  24214    S SPACE=$ J("",80)
  24215   "RTN","RCD PRLIS",47, 0)
  24216    S RCDK=$$ FMADD^XLFD T(DATESTRT ,-1)_".24"  ; Initial ize start  date for f irst $ORDE R
  24217   "RTN","RCD PRLIS",48, 0)
  24218    S DATEEND =DATEEND_" .24" ; Rec eipt date  opened can  include t ime, so co mpare with  midnight  on the end  date.
  24219   "RTN","RCD PRLIS",49, 0)
  24220    F  S RCDK =$O(^RCY(3 44,"AO",RC DK)) Q:(RC DK=""!(RCD K>DATEEND) )  D  ;
  24221   "RTN","RCD PRLIS",50, 0)
  24222    . S RCREC TDA=0 F  S  RCRECTDA= $O(^RCY(34 4,"AO",RCD K,RCRECTDA )) Q:'RCRE CTDA  D
  24223   "RTN","RCD PRLIS",51, 0)
  24224    . . K RCD PDATA
  24225   "RTN","RCD PRLIS",52, 0)
  24226    . . D DIQ 344^RCDPRP LM(RCRECTD A,".01:200 ")
  24227   "RTN","RCD PRLIS",53, 0)
  24228    . . ;  ge t fms docu ment ^ sta tus ^ pre  lockbox pa tch
  24229   "RTN","RCD PRLIS",54, 0)
  24230    . . S FMS DOCNO=$$FM SSTAT^RCDP UREC(RCREC TDA)
  24231   "RTN","RCD PRLIS",55, 0)
  24232    . . ; App ly filter  by FMS Sta tus
  24233   "RTN","RCD PRLIS",56, 0)
  24234    . . S FMS TATUS=$P(F MSDOCNO,"^ ",2)
  24235   "RTN","RCD PRLIS",57, 0)
  24236    . . I RCF ILTF,FMSTA TUS'="",'$ D(RCFILTF( FMSTATUS))  Q  ; this  status no t included
  24237   "RTN","RCD PRLIS",58, 0)
  24238    . . ; App ly filter  by Payment  Type
  24239   "RTN","RCD PRLIS",59, 0)
  24240    . . S PTY PE=RCDPDAT A(344,RCRE CTDA,.04," E")
  24241   "RTN","RCD PRLIS",60, 0)
  24242    . . I RCF ILTT,PTYPE '="",'$D(R CFILTT(PTY PE)) Q  ;  this statu s not incl uded
  24243   "RTN","RCD PRLIS",61, 0)
  24244    . . ;
  24245   "RTN","RCD PRLIS",62, 0)
  24246    . . ;  co mpute tota ls by type
  24247   "RTN","RCD PRLIS",63, 0)
  24248    . . I RCD PDATA(344, RCRECTDA,. 04,"E")=""  S RCDPDAT A(344,RCRE CTDA,.04," E")="UNKNO WN"
  24249   "RTN","RCD PRLIS",64, 0)
  24250    . . S $P( TOTALS(PTY PE),"^",1) =$P($G(TOT ALS(PTYPE) ),"^",1)+R CDPDATA(34 4,RCRECTDA ,101,"E")
  24251   "RTN","RCD PRLIS",65, 0)
  24252    . . S $P( TOTALS(PTY PE),"^",2) =$P($G(TOT ALS(PTYPE) ),"^",2)+R CDPDATA(34 4,RCRECTDA ,.15,"E")
  24253   "RTN","RCD PRLIS",66, 0)
  24254    . . S $P( TOTALS,"^" ,1)=$P($G( TOTALS),"^ ",1)+RCDPD ATA(344,RC RECTDA,101 ,"E")
  24255   "RTN","RCD PRLIS",67, 0)
  24256    . . S $P( TOTALS,"^" ,2)=$P($G( TOTALS),"^ ",2)+RCDPD ATA(344,RC RECTDA,.15 ,"E")
  24257   "RTN","RCD PRLIS",68, 0)
  24258    . . ;
  24259   "RTN","RCD PRLIS",69, 0)
  24260    . . ;  op ened by
  24261   "RTN","RCD PRLIS",70, 0)
  24262    . . I RCD PDATA(344, RCRECTDA,. 02,"I")=.5  D  ;
  24263   "RTN","RCD PRLIS",71, 0)
  24264    . . . S R CUSER="ar"
  24265   "RTN","RCD PRLIS",72, 0)
  24266    . . ; PRC A*4.5*332  Begin modi fied code  block
  24267   "RTN","RCD PRLIS",73, 0)
  24268    . . E  D   ;
  24269   "RTN","RCD PRLIS",74, 0)
  24270    . . . S R CUSER=RCDP DATA(344,R CRECTDA,.0 2,"E")
  24271   "RTN","RCD PRLIS",75, 0)
  24272    . . . I R CUSER'=""  D
  24273   "RTN","RCD PRLIS",76, 0)
  24274    . . . . S  RCUSER=$E ($P(RCUSER ,",",1),1, 5)_","_$E( $P(RCUSER, ",",2),1)
  24275   "RTN","RCD PRLIS",77, 0)
  24276    . . ;
  24277   "RTN","RCD PRLIS",78, 0)
  24278    . . S DAT A=RCDPDATA (344,RCREC TDA,.01,"E ")             ; Rece ipt number
  24279   "RTN","RCD PRLIS",79, 0)
  24280    . . S DAT A=DATA_"^" _RCDPDATA( 344,RCRECT DA,.03,"I" )   ; Date  opened
  24281   "RTN","RCD PRLIS",80, 0)
  24282    . . S ZZ= $$TYPE(RCD PDATA(344, RCRECTDA,. 04,"E"))       ; Paym ent type
  24283   "RTN","RCD PRLIS",81, 0)
  24284    . . S DAT A=DATA_"^" _ZZ                                  ; Paym ent type
  24285   "RTN","RCD PRLIS",82, 0)
  24286    . . S DAT A=DATA_"^" _RCUSER                              ; User  initials
  24287   "RTN","RCD PRLIS",83, 0)
  24288    . . S DAT A=DATA_"^" _RCDPDATA( 344,RCRECT DA,101,"E" )   ; Paym ent count
  24289   "RTN","RCD PRLIS",84, 0)
  24290    . . S DAT A=DATA_"^" _RCDPDATA( 344,RCRECT DA,.15,"E" )   ; Paym ent amount
  24291   "RTN","RCD PRLIS",85, 0)
  24292    . . S DAT A=DATA_"^" _$S($P(FMS DOCNO,"^", 3):"*",1:"  ") ; Pre  lockbox
  24293   "RTN","RCD PRLIS",86, 0)
  24294    . . S DAT A=DATA_"^" _$P(FMSDOC NO,"^")                   ; FMS  CR documen t
  24295   "RTN","RCD PRLIS",87, 0)
  24296    . . S ZZ= $$STATUS($ P(FMSDOCNO ,"^",2))                  ; FMS  CR doc sta tus
  24297   "RTN","RCD PRLIS",88, 0)
  24298    . . ; PRC A*4.5*332  End modifi ed code bl ock
  24299   "RTN","RCD PRLIS",89, 0)
  24300    . . S DAT A=DATA_"^" _ZZ                                  ; FMS  CR doc sta tus
  24301   "RTN","RCD PRLIS",90, 0)
  24302    . . S DAT A=DATA_"^" _RCRECTDA                            ; IEN  of file 34 4
  24303   "RTN","RCD PRLIS",91, 0)
  24304    . . ;
  24305   "RTN","RCD PRLIS",92, 0)
  24306    . . ; Ind ex ^TMP gl obal by us er selecte d sort ord er
  24307   "RTN","RCD PRLIS",93, 0)
  24308    . . I RCS ORT="D" S  RCIX=RCDPD ATA(344,RC RECTDA,.03 ,"I")
  24309   "RTN","RCD PRLIS",94, 0)
  24310    . . I RCS ORT="F" S  RCIX=FMSTA TUS
  24311   "RTN","RCD PRLIS",95, 0)
  24312    . . I RCS ORT="T" S  RCIX=PTYPE
  24313   "RTN","RCD PRLIS",96, 0)
  24314    . . S ^TM P($J,"RCDP RLIS","SOR T",RCIX,RC RECTDA)=DA TA
  24315   "RTN","RCD PRLIS",97, 0)
  24316    ;
  24317   "RTN","RCD PRLIS",98, 0)
  24318    S Y=$P(DA TESTRT,"." ) S DATEDI S1=$$FMTE^ XLFDT(Y,"2 DZ")
  24319   "RTN","RCD PRLIS",99, 0)
  24320    S Y=$P(DA TEEND,".")  S DATEDIS 2=$$FMTE^X LFDT(Y,"2D Z")
  24321   "RTN","RCD PRLIS",100 ,0)
  24322    D NOW^%DT C S Y=% D  DD^%DT S N OW=Y
  24323   "RTN","RCD PRLIS",101 ,0)
  24324    S PAGE=1, RCRJLINE=" ",$P(RCRJL INE,"-",81 )=""
  24325   "RTN","RCD PRLIS",102 ,0)
  24326    S SCREEN= 0 I '$D(ZT QUEUED),'$ G(RCLSTMGR ),IO=IO(0) ,$E(IOST)= "C" S SCRE EN=1
  24327   "RTN","RCD PRLIS",103 ,0)
  24328    D HDR ; C ompile hea der in to  ^TMP for u se in repo rt or List Man
  24329   "RTN","RCD PRLIS",104 ,0)
  24330    U IO D:'$ G(RCLSTMGR ) H
  24331   "RTN","RCD PRLIS",105 ,0)
  24332    S CNT=0
  24333   "RTN","RCD PRLIS",106 ,0)
  24334    S RCIX=0  F  S RCIX= $O(^TMP($J ,"RCDPRLIS ","SORT",R CIX)) Q:RC IX=""!($G( RCRJFLAG))   D
  24335   "RTN","RCD PRLIS",107 ,0)
  24336    . S RCREC TDA=0 F  S  RCRECTDA= $O(^TMP($J ,"RCDPRLIS ","SORT",R CIX,RCRECT DA)) Q:'RC RECTDA!($G (RCRJFLAG) )  D
  24337   "RTN","RCD PRLIS",108 ,0)
  24338    . . S DAT A=^TMP($J, "RCDPRLIS" ,"SORT",RC IX,RCRECTD A)
  24339   "RTN","RCD PRLIS",109 ,0)
  24340    . . S DAT E=$P(DATA, "^",2)
  24341   "RTN","RCD PRLIS",110 ,0)
  24342    . . S CNT =CNT+1
  24343   "RTN","RCD PRLIS",111 ,0)
  24344    . . S XX= ""
  24345   "RTN","RCD PRLIS",112 ,0)
  24346    . . I RCL STMGR S XX =" "_$E(CN T_SPACE,1, 4)_" "                             ; line n umber (for  listman)
  24347   "RTN","RCD PRLIS",113 ,0)
  24348    . . S XX= XX_$$FMTE^ XLFDT(DATE ,"2ZD")_"  "                                  ; date o pened
  24349   "RTN","RCD PRLIS",114 ,0)
  24350    . . S XX= XX_$E($P(D ATA,"^",1) _SPACE,1,1 2)_" "                             ; receip t number
  24351   "RTN","RCD PRLIS",115 ,0)
  24352    . . S XX= XX_$E($P(D ATA,"^",3) _SPACE,1,$ S(RCLSTMGR :5,1:6))_"  "           ; paymen t type  PR CA*4.5*332
  24353   "RTN","RCD PRLIS",116 ,0)
  24354    . . S XX= XX_$E($P(D ATA,"^",4) _SPACE,1,7 )_" "                              ; user i nitials PR CA*4.5*332
  24355   "RTN","RCD PRLIS",117 ,0)
  24356    . . S XX= XX_$J($P(D ATA,"^",5) ,5)                                           ; paymen t count
  24357   "RTN","RCD PRLIS",118 ,0)
  24358    . . S XX= XX_$J($P(D ATA,"^",6) ,$S(RCLSTM GR:11,1:13 ),2)_" "                ; paymen t amount
  24359   "RTN","RCD PRLIS",119 ,0)
  24360    . . S XX= XX_$E($P(D ATA,"^",7) _SPACE,1)                                     ; pre lo ckbox
  24361   "RTN","RCD PRLIS",120 ,0)
  24362    . . S XX= XX_$E($P(D ATA,"^",8) _SPACE,1,1 6)_" "                             ; fms cr  document
  24363   "RTN","RCD PRLIS",121 ,0)
  24364    . . S XX= XX_$E($P(D ATA,"^",9) ,1,6)                                         ; fms cr  doc statu s
  24365   "RTN","RCD PRLIS",122 ,0)
  24366    . . ;
  24367   "RTN","RCD PRLIS",123 ,0)
  24368    . . ; Wri te line or  put it to  global
  24369   "RTN","RCD PRLIS",124 ,0)
  24370    . . I '$G (RCLSTMGR)  D  ;
  24371   "RTN","RCD PRLIS",125 ,0)
  24372    . . . W ! ,XX
  24373   "RTN","RCD PRLIS",126 ,0)
  24374    . . E  D   ;
  24375   "RTN","RCD PRLIS",127 ,0)
  24376    . . . S ^ TMP($J,"RC DPRLIS",CN T)=XX
  24377   "RTN","RCD PRLIS",128 ,0)
  24378    . . . S ^ TMP($J,"RC DPRLIS","I DX",CNT)=$ P(DATA,"^" ,10) ; Cro ss referen ce line# v s file 344  DA
  24379   "RTN","RCD PRLIS",129 ,0)
  24380    . . ;
  24381   "RTN","RCD PRLIS",130 ,0)
  24382    . . ;  se t pre lock box flag t o 1 to sho w note at  end of rep ort
  24383   "RTN","RCD PRLIS",131 ,0)
  24384    . . I $P( DATA,"^",7 )="*" S RC DPFPRE=1
  24385   "RTN","RCD PRLIS",132 ,0)
  24386    . . ;
  24387   "RTN","RCD PRLIS",133 ,0)
  24388    . . I '$G (RCLSTMGR) ,$Y>(IOSL- 6) D:SCREE N PAUSE^RC RJRTR1 Q:$ G(RCRJFLAG )  D H
  24389   "RTN","RCD PRLIS",134 ,0)
  24390    ;
  24391   "RTN","RCD PRLIS",135 ,0)
  24392    I $G(RCLS TMGR) Q  ;  PRCA*4.5* 321 - Tota ls don't h ave a plac e in a pro tocol list  with acti ons
  24393   "RTN","RCD PRLIS",136 ,0)
  24394    ;
  24395   "RTN","RCD PRLIS",137 ,0)
  24396    I $G(RCRJ FLAG) D CL EAN Q
  24397   "RTN","RCD PRLIS",138 ,0)
  24398    I $G(RCDP FPRE) W !? 54,"*CR ti ed to depo sit"
  24399   "RTN","RCD PRLIS",139 ,0)
  24400    W !?33,"- -----  --- --------"
  24401   "RTN","RCD PRLIS",140 ,0)
  24402    W !?33,$J ($P($G(TOT ALS),"^"), 6),$J($P($ G(TOTALS), "^",2),13, 2)
  24403   "RTN","RCD PRLIS",141 ,0)
  24404    ;
  24405   "RTN","RCD PRLIS",142 ,0)
  24406    ;  show t otals by t ype of pay ment
  24407   "RTN","RCD PRLIS",143 ,0)
  24408    W !!,"TOT ALS BY TYP E OF PAYME NT"
  24409   "RTN","RCD PRLIS",144 ,0)
  24410    W !,"---- ---------- ---------- -"
  24411   "RTN","RCD PRLIS",145 ,0)
  24412    S TYPE=""  F  S TYPE =$O(TOTALS (TYPE)) Q: TYPE=""!($ G(RCRJFLAG ))  D
  24413   "RTN","RCD PRLIS",146 ,0)
  24414    .   W !,T YPE,?33,$J ($P(TOTALS (TYPE),"^" ),6),$J($P (TOTALS(TY PE),"^",2) ,13,2)
  24415   "RTN","RCD PRLIS",147 ,0)
  24416    .   I $Y> (IOSL-6) D :SCREEN PA USE^RCRJRT R1 Q:$G(RC RJFLAG)  D  H
  24417   "RTN","RCD PRLIS",148 ,0)
  24418    ;
  24419   "RTN","RCD PRLIS",149 ,0)
  24420    W !!,"***  END OF RE PORT ***", !
  24421   "RTN","RCD PRLIS",150 ,0)
  24422    ;
  24423   "RTN","RCD PRLIS",151 ,0)
  24424    I $G(RCRJ FLAG) D CL EAN Q
  24425   "RTN","RCD PRLIS",152 ,0)
  24426    I SCREEN  U IO(0) R  !,"Press R ETURN to c ontinue:", %:DTIME
  24427   "RTN","RCD PRLIS",153 ,0)
  24428    ;
  24429   "RTN","RCD PRLIS",154 ,0)
  24430    I '$G(RCL STMGR) D C LEAN
  24431   "RTN","RCD PRLIS",155 ,0)
  24432    Q
  24433   "RTN","RCD PRLIS",156 ,0)
  24434    ;
  24435   "RTN","RCD PRLIS",157 ,0)
  24436   TYPE(AREVE NT) ; Retu rns an abb reviated t ype of the  AR EVENT  - PRCA*4.5 *332 Subro utine adde d
  24437   "RTN","RCD PRLIS",158 ,0)
  24438    ; Input:    AREVENT  - External  AR Event  Type (file  344, fiel d .04)
  24439   "RTN","RCD PRLIS",159 ,0)
  24440    ; Returns : 6 charac ter (max)  event type  abbreviat ion
  24441   "RTN","RCD PRLIS",160 ,0)
  24442    I AREVENT ="EDI LOCK BOX" Q "ED I"
  24443   "RTN","RCD PRLIS",161 ,0)
  24444    I AREVENT ="CASH PAY MENT" Q "C ASH"
  24445   "RTN","RCD PRLIS",162 ,0)
  24446    I AREVENT ="CHECK/MO  PAYMENT"  Q "CHECK"
  24447   "RTN","RCD PRLIS",163 ,0)
  24448    I AREVENT ="LOCKBOX"  Q "LOCKBX "
  24449   "RTN","RCD PRLIS",164 ,0)
  24450    Q $E(AREV ENT,1,6)
  24451   "RTN","RCD PRLIS",165 ,0)
  24452    ;
  24453   "RTN","RCD PRLIS",166 ,0)
  24454   STATUS(STA TUS) ; Ret urns an ab breviated  status of  the FMS Do c Status -  PRCA*4.5* 332 Subrou tine added
  24455   "RTN","RCD PRLIS",167 ,0)
  24456    ; Input:    STATUS -  2nd word  of the FMS  Doc Statu s
  24457   "RTN","RCD PRLIS",168 ,0)
  24458    ; Returns : 9 charac ter (max)  status
  24459   "RTN","RCD PRLIS",169 ,0)
  24460    S STATUS= $P(STATUS, " ",1)
  24461   "RTN","RCD PRLIS",170 ,0)
  24462    I STATUS= "TRANSMITT ED" Q "XMI T"
  24463   "RTN","RCD PRLIS",171 ,0)
  24464    I STATUS= "ACCEPTED"  Q "ACCEPT "
  24465   "RTN","RCD PRLIS",172 ,0)
  24466    I STATUS= "REJECTED"  Q "REJECT "
  24467   "RTN","RCD PRLIS",173 ,0)
  24468    I STATUS= "NOT" Q "N OTENT"
  24469   "RTN","RCD PRLIS",174 ,0)
  24470    I STATUS= "ON" Q "ON LINE"
  24471   "RTN","RCD PRLIS",175 ,0)
  24472    Q STATUS
  24473   "RTN","RCD PRLIS",176 ,0)
  24474    ;
  24475   "RTN","RCD PRLIS",177 ,0)
  24476   CLEAN ; Cl ean up ^TM P arrays
  24477   "RTN","RCD PRLIS",178 ,0)
  24478    D ^%ZISC
  24479   "RTN","RCD PRLIS",179 ,0)
  24480    K ^TMP($J ,"RCDPRLIS ")
  24481   "RTN","RCD PRLIS",180 ,0)
  24482    Q
  24483   "RTN","RCD PRLIS",181 ,0)
  24484    ;
  24485   "RTN","RCD PRLIS",182 ,0)
  24486   SORTSEL()  ; Select s ort order  for report , by Date  Opened, FM S Status o r Payment  Type
  24487   "RTN","RCD PRLIS",183 ,0)
  24488    ; Input:  None
  24489   "RTN","RCD PRLIS",184 ,0)
  24490    ; Return:  Sort Type  D - Date,  F - FMS S tatus, T -  Payment T ype
  24491   "RTN","RCD PRLIS",185 ,0)
  24492    N DIR,X,Y ,DUOUT,DTO UT,DIRUT,D IROUT,RCRE P
  24493   "RTN","RCD PRLIS",186 ,0)
  24494    W !
  24495   "RTN","RCD PRLIS",187 ,0)
  24496    S DIR(0)= "SOA^D:Dat e;F:FMS St atus;T:Typ e of payme nt"
  24497   "RTN","RCD PRLIS",188 ,0)
  24498    S DIR("A" )="Sort By  (D)ATE OP ENED, (F)M S STATUS O R (T)YPE O F PAYMENT:  "
  24499   "RTN","RCD PRLIS",189 ,0)
  24500    S DIR("B" )="D"
  24501   "RTN","RCD PRLIS",190 ,0)
  24502    S DIR("?" ,1)="Selec t the orde r you wish  the recei pts to app ear in on  the report ."
  24503   "RTN","RCD PRLIS",191 ,0)
  24504    S DIR("?" ,2)=" "
  24505   "RTN","RCD PRLIS",192 ,0)
  24506    S DIR("?" ,3)="    D  - Sort by  the date  the receip t was open ed"
  24507   "RTN","RCD PRLIS",193 ,0)
  24508    S DIR("?" ,4)="    S  - Sort by  the FMS S tatus"
  24509   "RTN","RCD PRLIS",194 ,0)
  24510    S DIR("?" )="    T -  Sort by t he Payment  Type"
  24511   "RTN","RCD PRLIS",195 ,0)
  24512    D ^DIR
  24513   "RTN","RCD PRLIS",196 ,0)
  24514    I $D(DTOU T)!$D(DUOU T)!(Y="")  S RETURN=- 1
  24515   "RTN","RCD PRLIS",197 ,0)
  24516    E  S RETU RN=Y
  24517   "RTN","RCD PRLIS",198 ,0)
  24518    Q RETURN
  24519   "RTN","RCD PRLIS",199 ,0)
  24520    ;
  24521   "RTN","RCD PRLIS",200 ,0)
  24522   SELFILTF(R ETURN) ; A sk if user  want to f ilter by F MS status.  If yes ge t list of  status.
  24523   "RTN","RCD PRLIS",201 ,0)
  24524    ; Input:  None
  24525   "RTN","RCD PRLIS",202 ,0)
  24526    ; Output:  RETURN, p assed by r eference
  24527   "RTN","RCD PRLIS",203 ,0)
  24528    ;          RETURN -  1=Filter b y FMS Stat us, 0=Don' t
  24529   "RTN","RCD PRLIS",204 ,0)
  24530    ;          RETURN(ST ATUS) - ar ray of FMS  Status to  include i n the repo rt
  24531   "RTN","RCD PRLIS",205 ,0)
  24532    ; 
  24533   "RTN","RCD PRLIS",206 ,0)
  24534    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,J,QUIT,R CODES,RCOU T,X,Y
  24535   "RTN","RCD PRLIS",207 ,0)
  24536    K RETURN
  24537   "RTN","RCD PRLIS",208 ,0)
  24538    S RETURN= 0
  24539   "RTN","RCD PRLIS",209 ,0)
  24540    ;
  24541   "RTN","RCD PRLIS",210 ,0)
  24542    W !
  24543   "RTN","RCD PRLIS",211 ,0)
  24544    S DIR(0)= "YA"
  24545   "RTN","RCD PRLIS",212 ,0)
  24546    S DIR("A" )="Filter  by FMS Sta tus? (Y/N) : "
  24547   "RTN","RCD PRLIS",213 ,0)
  24548    S DIR("B" )="NO"
  24549   "RTN","RCD PRLIS",214 ,0)
  24550    S DIR("?" ,1)="Enter  'Y' or 'Y es' to onl y show rec eipts with  selected  FMS Status "
  24551   "RTN","RCD PRLIS",215 ,0)
  24552    S DIR("?" ,2)="Enter  'N' or 'N o' if you  wish to sh ow receipt s includin g all FMS  Status"
  24553   "RTN","RCD PRLIS",216 ,0)
  24554    S DIR("?" )="If you  select yes , you will  be prompt ed for the  FMS Statu s' you wis h to inclu de"
  24555   "RTN","RCD PRLIS",217 ,0)
  24556    D ^DIR
  24557   "RTN","RCD PRLIS",218 ,0)
  24558    I $D(DIRU T) S RETUR N=-1 Q
  24559   "RTN","RCD PRLIS",219 ,0)
  24560    I Y=0 Q
  24561   "RTN","RCD PRLIS",220 ,0)
  24562    S RETURN= 1
  24563   "RTN","RCD PRLIS",221 ,0)
  24564    ;
  24565   "RTN","RCD PRLIS",222 ,0)
  24566    ; Prompt  for status ' to be in cluded. Mu lti-select
  24567   "RTN","RCD PRLIS",223 ,0)
  24568    W !
  24569   "RTN","RCD PRLIS",224 ,0)
  24570    D FIELD^D ID(2100.1, 3,"","POIN TER","RCOU T")
  24571   "RTN","RCD PRLIS",225 ,0)
  24572    S RCODES= RCOUT("POI NTER")
  24573   "RTN","RCD PRLIS",226 ,0)
  24574    ; Add pse udo codes  to list fo r "NOT ENT ERED" and  "ON LINE E NTRY" retu rned by FM SSTAT^RCDP UREC
  24575   "RTN","RCD PRLIS",227 ,0)
  24576    I $E(RCOD ES,$L(RCOD ES))'=";"  S RCODES=R CODES_";"
  24577   "RTN","RCD PRLIS",228 ,0)
  24578    S RCODES= RCODES_"O: ON LINE EN TRY;N:NOT  ENTERED"
  24579   "RTN","RCD PRLIS",229 ,0)
  24580    K DIR
  24581   "RTN","RCD PRLIS",230 ,0)
  24582    S DIR(0)= "SOA^"_RCO DES
  24583   "RTN","RCD PRLIS",231 ,0)
  24584    S DIR("A" )="Select  an FMS Sta tus to inc lude in th e report:  "
  24585   "RTN","RCD PRLIS",232 ,0)
  24586    K DIR("?" )
  24587   "RTN","RCD PRLIS",233 ,0)
  24588    S DIR("?" ,1)="Selec t an FMS S tatus to s how in the  report."
  24589   "RTN","RCD PRLIS",234 ,0)
  24590    S DIR("?" ,2)="You w ill be pro mpted mult iple times , until yo u hit ENTE R"
  24591   "RTN","RCD PRLIS",235 ,0)
  24592    S DIR("?" )="without  making a  selection. "
  24593   "RTN","RCD PRLIS",236 ,0)
  24594    S QUIT=0
  24595   "RTN","RCD PRLIS",237 ,0)
  24596    F  D  I Q UIT Q
  24597   "RTN","RCD PRLIS",238 ,0)
  24598    . W !
  24599   "RTN","RCD PRLIS",239 ,0)
  24600    . D ^DIR
  24601   "RTN","RCD PRLIS",240 ,0)
  24602    . I $D(DT OUT)!$D(DU OUT) K RET URN S RETU RN=-1,QUIT =1 Q
  24603   "RTN","RCD PRLIS",241 ,0)
  24604    . I Y=""  S QUIT=1 Q
  24605   "RTN","RCD PRLIS",242 ,0)
  24606    . S RETUR N(Y(0))=""
  24607   "RTN","RCD PRLIS",243 ,0)
  24608    . ; Rebui d DIR(0) t o only inc lude codes  not yet s elected
  24609   "RTN","RCD PRLIS",244 ,0)
  24610    . S DIR(0 )=$$BLDS(R CODES,.RET URN)
  24611   "RTN","RCD PRLIS",245 ,0)
  24612    . I $P(DI R(0),"^",2 )="" S QUI T=1 ; All  status sel ected so s top prompt ing.
  24613   "RTN","RCD PRLIS",246 ,0)
  24614    I RETURN= -1 Q
  24615   "RTN","RCD PRLIS",247 ,0)
  24616    ; If no F MS Status'  were sele cted, don' t filter b y it.
  24617   "RTN","RCD PRLIS",248 ,0)
  24618    I $O(RETU RN(""))=""  D  ;
  24619   "RTN","RCD PRLIS",249 ,0)
  24620    . S RETUR N=0
  24621   "RTN","RCD PRLIS",250 ,0)
  24622    . W !!,"N o FMS Stat us' were s elected. A ll FMS Sta tus' will  be shown", !
  24623   "RTN","RCD PRLIS",251 ,0)
  24624    Q
  24625   "RTN","RCD PRLIS",252 ,0)
  24626    ;
  24627   "RTN","RCD PRLIS",253 ,0)
  24628   SELFILTT(R ETURN) ; A sk if user  want to f ilter by P ayment Typ e. If yes  get list o f types.
  24629   "RTN","RCD PRLIS",254 ,0)
  24630    ; Input:  None
  24631   "RTN","RCD PRLIS",255 ,0)
  24632    ; Output:  RETURN, p assed by r eference
  24633   "RTN","RCD PRLIS",256 ,0)
  24634    ;          RETURN -  1=Filter b y FMS Stat us, 0=Don' t
  24635   "RTN","RCD PRLIS",257 ,0)
  24636    ;          RETURN(ST ATUS) - ar ray of FMS  Status to  include i n the repo rt
  24637   "RTN","RCD PRLIS",258 ,0)
  24638    ; 
  24639   "RTN","RCD PRLIS",259 ,0)
  24640    N DIR,DIR OUT,DIRUT, DTOUT,DUOU T,RCODES,R CIEN,RCNAM E,QUIT,X,Y
  24641   "RTN","RCD PRLIS",260 ,0)
  24642    K RETURN
  24643   "RTN","RCD PRLIS",261 ,0)
  24644    S RETURN= 0
  24645   "RTN","RCD PRLIS",262 ,0)
  24646    ;
  24647   "RTN","RCD PRLIS",263 ,0)
  24648    W !
  24649   "RTN","RCD PRLIS",264 ,0)
  24650    S DIR(0)= "YA"
  24651   "RTN","RCD PRLIS",265 ,0)
  24652    S DIR("A" )="Filter  by Payment  Type? (Y/ N): "
  24653   "RTN","RCD PRLIS",266 ,0)
  24654    S DIR("B" )="NO"
  24655   "RTN","RCD PRLIS",267 ,0)
  24656    S DIR("?" ,1)="Enter  'Y' or 'Y es' to onl y show rec eipts with  selected  Payment Ty pes"
  24657   "RTN","RCD PRLIS",268 ,0)
  24658    S DIR("?" ,2)="Enter  'N' or 'N o' if you  wish to sh ow receipt s includin g all Paym ent Types"
  24659   "RTN","RCD PRLIS",269 ,0)
  24660    S DIR("?" )="If you  select yes , you will  be prompt ed for the  Payment T ypes you w ish to inc lude"
  24661   "RTN","RCD PRLIS",270 ,0)
  24662    D ^DIR
  24663   "RTN","RCD PRLIS",271 ,0)
  24664    I $D(DIRU T) S RETUR N=-1 Q
  24665   "RTN","RCD PRLIS",272 ,0)
  24666    I Y=0 Q
  24667   "RTN","RCD PRLIS",273 ,0)
  24668    S RETURN= 1
  24669   "RTN","RCD PRLIS",274 ,0)
  24670    ;
  24671   "RTN","RCD PRLIS",275 ,0)
  24672    ; Prompt  for types  to be incl uded. Mult i-select
  24673   "RTN","RCD PRLIS",276 ,0)
  24674    W !
  24675   "RTN","RCD PRLIS",277 ,0)
  24676    K DIR
  24677   "RTN","RCD PRLIS",278 ,0)
  24678    ; Present  payment t ypes as a  set of cod es to stre amline use r interfac e/selectio n/help
  24679   "RTN","RCD PRLIS",279 ,0)
  24680    S (RCODES ,RCNAME)=" "
  24681   "RTN","RCD PRLIS",280 ,0)
  24682    F  S RCNA ME=$O(^RC( 341.1,"B", RCNAME)) Q :RCNAME=""   D  ;
  24683   "RTN","RCD PRLIS",281 ,0)
  24684    . S RCIEN =0 F  S RC IEN=$O(^RC (341.1,"B" ,RCNAME,RC IEN)) Q:'R CIEN  D  ;
  24685   "RTN","RCD PRLIS",282 ,0)
  24686    . . I $$G ET1^DIQ(34 1.1,RCIEN_ ",",.06,"I ")=1 D  ;
  24687   "RTN","RCD PRLIS",283 ,0)
  24688    . . . S R CODES=RCOD ES_":"_$$G ET1^DIQ(34 1.1,RCIEN_ ",",.01,"E ")_";"
  24689   "RTN","RCD PRLIS",284 ,0)
  24690    S DIR(0)= "SOA^"_RCO DES
  24691   "RTN","RCD PRLIS",285 ,0)
  24692    S DIR("A" )="Select  a Payment  Type to in clude in t he report:  "
  24693   "RTN","RCD PRLIS",286 ,0)
  24694    K DIR("?" )
  24695   "RTN","RCD PRLIS",287 ,0)
  24696    S DIR("?" ,1)="Selec t an Payme nt Type to  include i n the repo rt."
  24697   "RTN","RCD PRLIS",288 ,0)
  24698    S DIR("?" ,2)="You w ill be pro mpted mult iple times , until yo u hit ENTE R"
  24699   "RTN","RCD PRLIS",289 ,0)
  24700    S DIR("?" )="without  making a  selection. "
  24701   "RTN","RCD PRLIS",290 ,0)
  24702    S QUIT=0
  24703   "RTN","RCD PRLIS",291 ,0)
  24704    F  D  I Q UIT Q
  24705   "RTN","RCD PRLIS",292 ,0)
  24706    . W !
  24707   "RTN","RCD PRLIS",293 ,0)
  24708    . D ^DIR
  24709   "RTN","RCD PRLIS",294 ,0)
  24710    . I $D(DT OUT)!$D(DU OUT) K RET URN S RETU RN=-1,QUIT =1 Q
  24711   "RTN","RCD PRLIS",295 ,0)
  24712    . I $G(Y( 0))="" S Q UIT=1 Q
  24713   "RTN","RCD PRLIS",296 ,0)
  24714    . S RETUR N(Y(0))=""
  24715   "RTN","RCD PRLIS",297 ,0)
  24716    . ; Rebui d DIR(0) t o only inc lude codes  not yet s elected
  24717   "RTN","RCD PRLIS",298 ,0)
  24718    . S DIR(0 )=$$BLDS(R CODES,.RET URN)
  24719   "RTN","RCD PRLIS",299 ,0)
  24720    . I $P(DI R(0),"^",2 )="" S QUI T=1 ; All  status sel ected so s top prompt ing.
  24721   "RTN","RCD PRLIS",300 ,0)
  24722    ;
  24723   "RTN","RCD PRLIS",301 ,0)
  24724    I RETURN= -1 Q
  24725   "RTN","RCD PRLIS",302 ,0)
  24726    ; If no p ayment typ es were se lected, do n't filter  by it.
  24727   "RTN","RCD PRLIS",303 ,0)
  24728    I $O(RETU RN(""))=""  D  ;
  24729   "RTN","RCD PRLIS",304 ,0)
  24730    . S RETUR N=0
  24731   "RTN","RCD PRLIS",305 ,0)
  24732    . W !!,"N o Payment  Types were  selected.  Filter wi ll not be  used",!
  24733   "RTN","RCD PRLIS",306 ,0)
  24734    Q
  24735   "RTN","RCD PRLIS",307 ,0)
  24736    ;
  24737   "RTN","RCD PRLIS",308 ,0)
  24738   BLDS(CODES ,PICKED) ;  Build DIR (0) string  taking in to account  codes alr eady picke d.
  24739   "RTN","RCD PRLIS",309 ,0)
  24740    ; Input:  CODES - Se t of codes  string in  fileman f ormat e.g.  A:Apple;B :Ball;
  24741   "RTN","RCD PRLIS",310 ,0)
  24742    ;         PICKED - A rray of va lues alrea dy picked,  subscript ed by exte rnal value  e.g. PICK ED("Apple" )=""
  24743   "RTN","RCD PRLIS",311 ,0)
  24744    ; Return:  RETURN in  DIR(0) fo rmat. Set  of codes t hat only i ncludes on es not pic ked.
  24745   "RTN","RCD PRLIS",312 ,0)
  24746    ;          e.g "SAO^ B:Ball"
  24747   "RTN","RCD PRLIS",313 ,0)
  24748    ; 
  24749   "RTN","RCD PRLIS",314 ,0)
  24750    N RETURN
  24751   "RTN","RCD PRLIS",315 ,0)
  24752    S RETURN= "SOA^"
  24753   "RTN","RCD PRLIS",316 ,0)
  24754    F J=1:1:$ L(CODES,"; ") D  ;
  24755   "RTN","RCD PRLIS",317 ,0)
  24756    . S X=$P( $P(CODES," ;",J),":", 2)
  24757   "RTN","RCD PRLIS",318 ,0)
  24758    . I X'="" ,'$D(PICKE D(X)) S RE TURN=RETUR N_$P(CODES ,";",J)_"; "
  24759   "RTN","RCD PRLIS",319 ,0)
  24760    Q RETURN
  24761   "RTN","RCD PRLIS",320 ,0)
  24762    ;
  24763   "RTN","RCD PRLIS",321 ,0)
  24764   HDR ; Comp ile header  into ^TMP  for use i n ListMan  or report
  24765   "RTN","RCD PRLIS",322 ,0)
  24766    ; Input:  None
  24767   "RTN","RCD PRLIS",323 ,0)
  24768    ; Output:  Header in formation  in ^TMP($J ,"RCDPRLIS ","HDR",n)  for us in  report or  ListMan f ormats
  24769   "RTN","RCD PRLIS",324 ,0)
  24770    N K,XX
  24771   "RTN","RCD PRLIS",325 ,0)
  24772    S ^TMP($J ,"RCDPRLIS ","HDR",1) ="LIST OF  RECEIPTS R EPORT"
  24773   "RTN","RCD PRLIS",326 ,0)
  24774    S XX="  D ATE RANGE    : "_DATE DIS1_"  TO   "_DATEDI S2_"          "
  24775   "RTN","RCD PRLIS",327 ,0)
  24776    S XX=XX_" SORT ORDER : "_$S(RCS ORT="D":"D ATE OPENED ",RCSORT=" F":"FMS ST ATUS",1:"P AYMENT TYP E")
  24777   "RTN","RCD PRLIS",328 ,0)
  24778    S ^TMP($J ,"RCDPRLIS ","HDR",2) =XX
  24779   "RTN","RCD PRLIS",329 ,0)
  24780    ;
  24781   "RTN","RCD PRLIS",330 ,0)
  24782    I 'RCFILT F D  ;
  24783   "RTN","RCD PRLIS",331 ,0)
  24784    . S XX="A LL"
  24785   "RTN","RCD PRLIS",332 ,0)
  24786    E  D  ;
  24787   "RTN","RCD PRLIS",333 ,0)
  24788    . S XX=""
  24789   "RTN","RCD PRLIS",334 ,0)
  24790    . S K=""  F  S K=$O( RCFILTF(K) ) Q:K=""   S:XX'="" X X=XX_"; "  S XX=XX_K
  24791   "RTN","RCD PRLIS",335 ,0)
  24792    S ^TMP($J ,"RCDPRLIS ","HDR",3) ="  FMS ST ATUS   : " _$S($L(XX) >63:"SELEC TED",1:XX)
  24793   "RTN","RCD PRLIS",336 ,0)
  24794    ;
  24795   "RTN","RCD PRLIS",337 ,0)
  24796     I 'RCFIL TT D  ;
  24797   "RTN","RCD PRLIS",338 ,0)
  24798    . S XX="A LL"
  24799   "RTN","RCD PRLIS",339 ,0)
  24800    E  D  ;
  24801   "RTN","RCD PRLIS",340 ,0)
  24802    . S XX=""
  24803   "RTN","RCD PRLIS",341 ,0)
  24804    . S K=""  F  S K=$O( RCFILTT(K) ) Q:K=""   S:XX'="" X X=XX_"; "  S XX=XX_K
  24805   "RTN","RCD PRLIS",342 ,0)
  24806    S ^TMP($J ,"RCDPRLIS ","HDR",4) ="  PAYMEN T TYPES: " _$S($L(XX) >63:"SELEC TED",1:XX)
  24807   "RTN","RCD PRLIS",343 ,0)
  24808    ; PRCA*4. 5*332
  24809   "RTN","RCD PRLIS",344 ,0)
  24810    S ^TMP($J ,"RCDPRLIS ","HDR",5) ="DATE      RECEIPT       TYPE    USER    C OUNT        AMOUNT  F MS CR DOC        STAT US"
  24811   "RTN","RCD PRLIS",345 ,0)
  24812    W !,RCRJL INE
  24813   "RTN","RCD PRLIS",346 ,0)
  24814    Q
  24815   "RTN","RCD PRLIS",347 ,0)
  24816    ;
  24817   "RTN","RCD PRLIS",348 ,0)
  24818   H ;  heade r
  24819   "RTN","RCD PRLIS",349 ,0)
  24820    N %
  24821   "RTN","RCD PRLIS",350 ,0)
  24822    S %=NOW_"   PAGE "_P AGE,PAGE=P AGE+1 I PA GE'=2!(SCR EEN) W @IO F
  24823   "RTN","RCD PRLIS",351 ,0)
  24824    W $C(13), ^TMP($J,"R CDPRLIS"," HDR",1),?( 80-$L(%)), %
  24825   "RTN","RCD PRLIS",352 ,0)
  24826    W !,^TMP( $J,"RCDPRL IS","HDR", 2)
  24827   "RTN","RCD PRLIS",353 ,0)
  24828    W !,^TMP( $J,"RCDPRL IS","HDR", 3)
  24829   "RTN","RCD PRLIS",354 ,0)
  24830    W !,^TMP( $J,"RCDPRL IS","HDR", 4)
  24831   "RTN","RCD PRLIS",355 ,0)
  24832    W !,^TMP( $J,"RCDPRL IS","HDR", 5)
  24833   "RTN","RCD PRLIS",356 ,0)
  24834    W !,RCRJL INE
  24835   "RTN","RCD PRLIS",357 ,0)
  24836    Q
  24837   "RTN","RCD PRPL2")
  24838   0^38^B5794 9754
  24839   "RTN","RCD PRPL2",1,0 )
  24840   RCDPRPL2 ; WISC/RFJ-r eceipt pro file List  Manager op tions ;1 N ov 2018 13 :02:23
  24841   "RTN","RCD PRPL2",2,0 )
  24842    ;;4.5;Acc ounts Rece ivable;**1 14,148,173 ,217,332** ;Mar 20, 1 995;Build  34
  24843   "RTN","RCD PRPL2",3,0 )
  24844    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  24845   "RTN","RCD PRPL2",4,0 )
  24846    Q
  24847   "RTN","RCD PRPL2",5,0 )
  24848    ;
  24849   "RTN","RCD PRPL2",6,0 )
  24850    ; This ro utine cont ains entry  points fo r customiz ation and  printing
  24851   "RTN","RCD PRPL2",7,0 )
  24852    ;
  24853   "RTN","RCD PRPL2",8,0 )
  24854   ACCTPROF ; EP from pr otocol RCD P RECEIPT  PROFILE AC COUNT PROF ILE
  24855   "RTN","RCD PRPL2",9,0 )
  24856    ; Account  Profile a ction
  24857   "RTN","RCD PRPL2",10, 0)
  24858    D FULL^VA LM1
  24859   "RTN","RCD PRPL2",11, 0)
  24860    S VALMBCK ="R"
  24861   "RTN","RCD PRPL2",12, 0)
  24862    ;
  24863   "RTN","RCD PRPL2",13, 0)
  24864    N ACCT,RC DEBTDA,RCT RANDA
  24865   "RTN","RCD PRPL2",14, 0)
  24866    S RCTRAND A=$$SELPAY ^RCDPRPL1( RCRECTDA)   ; Select  payment tr ansaction
  24867   "RTN","RCD PRPL2",15, 0)
  24868    I RCTRAND A>0 D  ; F ind debtor  (file 340 ) entry
  24869   "RTN","RCD PRPL2",16, 0)
  24870    . S RCDEB TDA=0
  24871   "RTN","RCD PRPL2",17, 0)
  24872    . S ACCT= $P(^RCY(34 4,RCRECTDA ,1,RCTRAND A,0),U,3)   ; (#.03)  ACCOUNT [3 V]
  24873   "RTN","RCD PRPL2",18, 0)
  24874    . I ACCT[ "DPT(" S R CDEBTDA=$O (^RCD(340, "B",ACCT,0 ))
  24875   "RTN","RCD PRPL2",19, 0)
  24876    . I ACCT[ "PRCA(430, " S RCDEBT DA=$P($G(^ PRCA(430,+ ACCT,0)),U ,9)
  24877   "RTN","RCD PRPL2",20, 0)
  24878    . I 'RCDE BTDA S VAL MSG="Accou nt NOT fou nd for pay ment trans action."
  24879   "RTN","RCD PRPL2",21, 0)
  24880    ;
  24881   "RTN","RCD PRPL2",22, 0)
  24882    ; Payment  not selec ted ask to  select an  account
  24883   "RTN","RCD PRPL2",23, 0)
  24884    I '$D(RCD EBTDA) S R CDEBTDA=$$ SELACCT^RC DPAPLM
  24885   "RTN","RCD PRPL2",24, 0)
  24886    ;
  24887   "RTN","RCD PRPL2",25, 0)
  24888    Q:$G(RCDE BTDA)'>0
  24889   "RTN","RCD PRPL2",26, 0)
  24890    D EN^VALM ("RCDP ACC OUNT PROFI LE")
  24891   "RTN","RCD PRPL2",27, 0)
  24892    S VALMBCK ="R"
  24893   "RTN","RCD PRPL2",28, 0)
  24894    I $G(RCDP FXIT) S VA LMBCK="Q"   ; Fast ex it
  24895   "RTN","RCD PRPL2",29, 0)
  24896    Q
  24897   "RTN","RCD PRPL2",30, 0)
  24898    ;
  24899   "RTN","RCD PRPL2",31, 0)
  24900   PRINRECT ; EP from pr otocol act ion RCDP R ECEIPT PRO FILE PRINT  RECEIPT
  24901   "RTN","RCD PRPL2",32, 0)
  24902    ; Print a  receipt
  24903   "RTN","RCD PRPL2",33, 0)
  24904    D FULL^VA LM1
  24905   "RTN","RCD PRPL2",34, 0)
  24906    S VALMBCK ="R"
  24907   "RTN","RCD PRPL2",35, 0)
  24908    N RCTRAND A
  24909   "RTN","RCD PRPL2",36, 0)
  24910    ;
  24911   "RTN","RCD PRPL2",37, 0)
  24912    ; Select  the paymen t transact ion
  24913   "RTN","RCD PRPL2",38, 0)
  24914    S RCTRAND A=$$SELPAY ^RCDPRPL1( RCRECTDA)
  24915   "RTN","RCD PRPL2",39, 0)
  24916    Q:RCTRAND A<1
  24917   "RTN","RCD PRPL2",40, 0)
  24918    ;
  24919   "RTN","RCD PRPL2",41, 0)
  24920    ; Check i f transact ion has a  payment am ount
  24921   "RTN","RCD PRPL2",42, 0)
  24922    I '$P($G( ^RCY(344,R CRECTDA,1, RCTRANDA,0 )),U,4) D   Q
  24923   "RTN","RCD PRPL2",43, 0)
  24924    . S VALMS G="NO Paym ent Amount  on Transa ction."
  24925   "RTN","RCD PRPL2",44, 0)
  24926    ;
  24927   "RTN","RCD PRPL2",45, 0)
  24928    S VALMSG= $$DEVICE^R CDPRECT
  24929   "RTN","RCD PRPL2",46, 0)
  24930    I VALMSG= 0 S VALMSG ="Receipt  NOT printe d"
  24931   "RTN","RCD PRPL2",47, 0)
  24932    Q
  24933   "RTN","RCD PRPL2",48, 0)
  24934    ;
  24935   "RTN","RCD PRPL2",49, 0)
  24936   PRINT215 ; EP from pr otocol act ion RCDP R ECEIPT PRO FILE 215 R EPORT
  24937   "RTN","RCD PRPL2",50, 0)
  24938    ; Print 2 15 report
  24939   "RTN","RCD PRPL2",51, 0)
  24940    ; Input:    RCRECTDA     - IEN  of the sel ected rece ipt (#344)
  24941   "RTN","RCD PRPL2",52, 0)
  24942    N %ZIS,PO P,RECEIPDA ,RCTYPE
  24943   "RTN","RCD PRPL2",53, 0)
  24944    D FULL^VA LM1
  24945   "RTN","RCD PRPL2",54, 0)
  24946    S VALMBCK ="R",RECEI PDA=RCRECT DA
  24947   "RTN","RCD PRPL2",55, 0)
  24948    S RCTYPE= $$GETTYPE^ RCDPR215
  24949   "RTN","RCD PRPL2",56, 0)
  24950    I RCTYPE= "" Q
  24951   "RTN","RCD PRPL2",57, 0)
  24952    ;
  24953   "RTN","RCD PRPL2",58, 0)
  24954    ; Select  device
  24955   "RTN","RCD PRPL2",59, 0)
  24956    W !
  24957   "RTN","RCD PRPL2",60, 0)
  24958    S %ZIS="Q "
  24959   "RTN","RCD PRPL2",61, 0)
  24960    D ^%ZIS
  24961   "RTN","RCD PRPL2",62, 0)
  24962    Q:POP
  24963   "RTN","RCD PRPL2",63, 0)
  24964    I $D(IO(" Q")) D  D  ^%ZTLOAD K  IO("Q"),Z TSK D ^%ZI SC Q
  24965   "RTN","RCD PRPL2",64, 0)
  24966    . S ZTDES C="Print 2 15 Report" ,ZTRTN="DQ ^RCDPR215"
  24967   "RTN","RCD PRPL2",65, 0)
  24968    . S ZTSAV E("RECEIPD A")="",ZTS AVE("RCTYP E")="",ZTS AVE("ZTREQ ")="@"
  24969   "RTN","RCD PRPL2",66, 0)
  24970    W !!,"<*>  please wa it <*>"
  24971   "RTN","RCD PRPL2",67, 0)
  24972    D DQ^RCDP R215
  24973   "RTN","RCD PRPL2",68, 0)
  24974    Q
  24975   "RTN","RCD PRPL2",69, 0)
  24976    ;
  24977   "RTN","RCD PRPL2",70, 0)
  24978   CUSTOMIZ ; EP from pr otocol RCD P RECEIPT  PROFILE CU STOMIZE
  24979   "RTN","RCD PRPL2",71, 0)
  24980    ; Option  to customi ze display  and print ing of the  receipt
  24981   "RTN","RCD PRPL2",72, 0)
  24982    ; Input:    None
  24983   "RTN","RCD PRPL2",73, 0)
  24984    ; Output:   Receipt  Profile di splay and  printing o ptions cus tomized
  24985   "RTN","RCD PRPL2",74, 0)
  24986    N OPT,QUE S
  24987   "RTN","RCD PRPL2",75, 0)
  24988    D FULL^VA LM1
  24989   "RTN","RCD PRPL2",76, 0)
  24990    S VALMBCK ="R"
  24991   "RTN","RCD PRPL2",77, 0)
  24992    ;
  24993   "RTN","RCD PRPL2",78, 0)
  24994    W !!,"Thi s option w ill allow  the user t o customiz e the scre en and opt ions"
  24995   "RTN","RCD PRPL2",79, 0)
  24996    W !,"used  for recei pt process ing."
  24997   "RTN","RCD PRPL2",80, 0)
  24998    ;
  24999   "RTN","RCD PRPL2",81, 0)
  25000    ; Ask to  show check /credit ca rd data
  25001   "RTN","RCD PRPL2",82, 0)
  25002    S OPT="SH OWCHECK"
  25003   "RTN","RCD PRPL2",83, 0)
  25004    S QUES="   Do you wa nt to show  trace #,  check and  credit car d informat ion"
  25005   "RTN","RCD PRPL2",84, 0)
  25006    Q:$$ASKCU ST(OPT,QUE S)=-1
  25007   "RTN","RCD PRPL2",85, 0)
  25008    ;
  25009   "RTN","RCD PRPL2",86, 0)
  25010    ; Ask to  show acct  lookup, ba tch and se quence num ber
  25011   "RTN","RCD PRPL2",87, 0)
  25012    S OPT="SH OWACCT"
  25013   "RTN","RCD PRPL2",88, 0)
  25014    S QUES="   Do you wa nt to show  acct. loo kup, batch  and seque nce inform ation"
  25015   "RTN","RCD PRPL2",89, 0)
  25016    I $$ASKCU ST(OPT,QUE S)=-1 D IN IT^RCDPRPL M Q
  25017   "RTN","RCD PRPL2",90, 0)
  25018    ;
  25019   "RTN","RCD PRPL2",91, 0)
  25020    ; Ask to  show comme nts
  25021   "RTN","RCD PRPL2",92, 0)
  25022    S OPT="SH OWCOMMENTS ",QUES="   Do you wan t to show  comments"
  25023   "RTN","RCD PRPL2",93, 0)
  25024    I $$ASKCU ST(OPT,QUE S)=-1 D IN IT^RCDPRPL M Q
  25025   "RTN","RCD PRPL2",94, 0)
  25026    ;
  25027   "RTN","RCD PRPL2",95, 0)
  25028    ; Ask to  show FMS c r document s
  25029   "RTN","RCD PRPL2",96, 0)
  25030    S OPT="SH OWFMS"
  25031   "RTN","RCD PRPL2",97, 0)
  25032    S QUES="   Do you wa nt to show  the FMS c ash receip t document s"
  25033   "RTN","RCD PRPL2",98, 0)
  25034    I $$ASKCU ST(OPT,QUE S)=-1 D IN IT^RCDPRPL M Q
  25035   "RTN","RCD PRPL2",99, 0)
  25036    ;
  25037   "RTN","RCD PRPL2",100 ,0)
  25038    ; Ask to  show EOB d etail info rmation
  25039   "RTN","RCD PRPL2",101 ,0)
  25040    S OPT="SH OWEOB"
  25041   "RTN","RCD PRPL2",102 ,0)
  25042    S QUES="   Do you wa nt to show  electroni c EEOB det ail data"
  25043   "RTN","RCD PRPL2",103 ,0)
  25044    I $$ASKCU ST(OPT,QUE S)=-1 D IN IT^RCDPRPL M Q
  25045   "RTN","RCD PRPL2",104 ,0)
  25046    ;
  25047   "RTN","RCD PRPL2",105 ,0)
  25048    ; Make su re form is  rebuilt b ased on th e answers  above
  25049   "RTN","RCD PRPL2",106 ,0)
  25050    D INIT^RC DPRPLM
  25051   "RTN","RCD PRPL2",107 ,0)
  25052    ;
  25053   "RTN","RCD PRPL2",108 ,0)
  25054    W !!,"The  next prom pts will a llow the u ser to ind ividually  set up the  way recei pts"
  25055   "RTN","RCD PRPL2",109 ,0)
  25056    W !,"shou ld be prin ted when e ntering pa yment tran sactions.   The user  can set"
  25057   "RTN","RCD PRPL2",110 ,0)
  25058    W !,"the  software u p to autom atically p rint a rec eipt to a  device, ne ver print"
  25059   "RTN","RCD PRPL2",111 ,0)
  25060    W !,"the  receipt, o r ask to p rint the r eceipt.  T he user ca n also spe cify the"
  25061   "RTN","RCD PRPL2",112 ,0)
  25062    W !,"prin ter used f or printin g receipts , preventi ng from ha ving to re -enter it. "
  25063   "RTN","RCD PRPL2",113 ,0)
  25064    N DEVICE, TYPE
  25065   "RTN","RCD PRPL2",114 ,0)
  25066    ;
  25067   "RTN","RCD PRPL2",115 ,0)
  25068    ; For pri nting rece ipts
  25069   "RTN","RCD PRPL2",116 ,0)
  25070    D  Q:TYPE <0
  25071   "RTN","RCD PRPL2",117 ,0)
  25072    . W !
  25073   "RTN","RCD PRPL2",118 ,0)
  25074    . S TYPE= $$ASKRECT  Q:TYPE<0
  25075   "RTN","RCD PRPL2",119 ,0)
  25076    . ; Never  print rec eipt
  25077   "RTN","RCD PRPL2",120 ,0)
  25078    . I TYPE= 0 D RCSET( "RECEIPT", 0) Q
  25079   "RTN","RCD PRPL2",121 ,0)
  25080    . ; Ask d efault pri nter devic e
  25081   "RTN","RCD PRPL2",122 ,0)
  25082    . S DEVIC E=$$ASKDEV IC(1)
  25083   "RTN","RCD PRPL2",123 ,0)
  25084    . ; No de fault prin ter, alway s print re ceipt
  25085   "RTN","RCD PRPL2",124 ,0)
  25086    . I DEVIC E="",TYPE= 1 D  Q
  25087   "RTN","RCD PRPL2",125 ,0)
  25088    ..  W !," Since you  did not en ter a defa ult printe r for prin ting recei pts,"
  25089   "RTN","RCD PRPL2",126 ,0)
  25090    ..  W !," I will cha nge it so  the softwa re will as k you to p rint the r eceipt"
  25091   "RTN","RCD PRPL2",127 ,0)
  25092    ..  W !," when enter ing a paym ent transa ction."
  25093   "RTN","RCD PRPL2",128 ,0)
  25094    ..  D RCS ET("RECEIP T",2)
  25095   "RTN","RCD PRPL2",129 ,0)
  25096    . ; Set d efault pri nter for r eceipts
  25097   "RTN","RCD PRPL2",130 ,0)
  25098    . D RCSET ("RECEIPT" ,TYPE_U_DE VICE)
  25099   "RTN","RCD PRPL2",131 ,0)
  25100    ;
  25101   "RTN","RCD PRPL2",132 ,0)
  25102    ; For pri nting 215  report
  25103   "RTN","RCD PRPL2",133 ,0)
  25104    W !!!,"Yo u now have  the optio n of setti ng up the  default pr inter for  automatica lly"
  25105   "RTN","RCD PRPL2",134 ,0)
  25106    W !,"prin ting the 2 15 report  when a rec eipt is pr ocessed.", !
  25107   "RTN","RCD PRPL2",135 ,0)
  25108    ; Ask def ault print er device
  25109   "RTN","RCD PRPL2",136 ,0)
  25110    S DEVICE= $$ASKDEVIC (2)
  25111   "RTN","RCD PRPL2",137 ,0)
  25112    D RCSET(" 215REPORT" ,U_DEVICE)
  25113   "RTN","RCD PRPL2",138 ,0)
  25114    Q
  25115   "RTN","RCD PRPL2",139 ,0)
  25116    ;
  25117   "RTN","RCD PRPL2",140 ,0)
  25118   RCSET(RCSN PT,RCSLDV)  ; File th e selected  parameter  & device  as the use r's prefer ence
  25119   "RTN","RCD PRPL2",141 ,0)
  25120    ; RCSNPT   - Name of  the user' s preferen ce paramet er to file
  25121   "RTN","RCD PRPL2",142 ,0)
  25122    ; RCSLDV   - User's  preference ^Name of t he device  selected b y the user
  25123   "RTN","RCD PRPL2",143 ,0)
  25124    N DA,DIC, DIE,DR,X,Y
  25125   "RTN","RCD PRPL2",144 ,0)
  25126    ;
  25127   "RTN","RCD PRPL2",145 ,0)
  25128    ; If this  is a new  parameter,  file it
  25129   "RTN","RCD PRPL2",146 ,0)
  25130    I '$D(^RC (342.3,"B" ,RCSNPT))  D
  25131   "RTN","RCD PRPL2",147 ,0)
  25132    . K DD,DO ,DIC("DR")
  25133   "RTN","RCD PRPL2",148 ,0)
  25134    . S DIC=" ^RC(342.3, ",DIC(0)=" ",X=RCSNPT
  25135   "RTN","RCD PRPL2",149 ,0)
  25136    . D FILE^ DICN
  25137   "RTN","RCD PRPL2",150 ,0)
  25138    ;
  25139   "RTN","RCD PRPL2",151 ,0)
  25140    ; File us er's prefe rence for  the parame ter if the y don't ha ve one cur rently def ined
  25141   "RTN","RCD PRPL2",152 ,0)
  25142    S DA(1)=$ O(^RC(342. 3,"B",RCSN PT,0))
  25143   "RTN","RCD PRPL2",153 ,0)
  25144    I '$D(^RC (342.3,DA( 1),1,"B",D UZ)) D  Q
  25145   "RTN","RCD PRPL2",154 ,0)
  25146    . S DIC(0 )="",DIC(" P")=$P(^DD (342.3,1,0 ),U,2),DIC ="^RC(342. 3,"_DA(1)_ ",1,",X=DU Z
  25147   "RTN","RCD PRPL2",155 ,0)
  25148    . S DIC(" DR")="1/// /"_$P(RCSL DV,U,1)_"; 2////"_$P( RCSLDV,U,2 )
  25149   "RTN","RCD PRPL2",156 ,0)
  25150    . K DD,DO
  25151   "RTN","RCD PRPL2",157 ,0)
  25152    . D FILE^ DICN
  25153   "RTN","RCD PRPL2",158 ,0)
  25154    ;
  25155   "RTN","RCD PRPL2",159 ,0)
  25156    ; Edit th e user's p reference  for the pa rameter
  25157   "RTN","RCD PRPL2",160 ,0)
  25158    S DA=$O(^ RC(342.3,D A(1),1,"B" ,DUZ,0))
  25159   "RTN","RCD PRPL2",161 ,0)
  25160    S DR=".01 ////"_DUZ_ ";1////"_$ P(RCSLDV,U )_";2////" _$P(RCSLDV ,U,2)
  25161   "RTN","RCD PRPL2",162 ,0)
  25162    S DIE="^R C(342.3,"_ DA(1)_",1, "
  25163   "RTN","RCD PRPL2",163 ,0)
  25164    D ^DIE
  25165   "RTN","RCD PRPL2",164 ,0)
  25166    Q
  25167   "RTN","RCD PRPL2",165 ,0)
  25168    ;
  25169   "RTN","RCD PRPL2",166 ,0)
  25170   OPTCK(RCSN PT,RCSLDV)  ; functio n, return  user's pre ference fo r AR USER  CUSTOMIZE  parameter  (if define d)
  25171   "RTN","RCD PRPL2",167 ,0)
  25172    ; Input:    RCSNPT   - Name of  the AR USE R CUSTOMIZ E (#342.3)  parameter  to check
  25173   "RTN","RCD PRPL2",168 ,0)
  25174    ;           RCLSDV   - Piece to  be retrie ved off of  the 342.3  record
  25175   "RTN","RCD PRPL2",169 ,0)
  25176    ; Returns : user's p reference  for RCSNPT  or null i f no prefe rence in f ile
  25177   "RTN","RCD PRPL2",170 ,0)
  25178    N RCDA
  25179   "RTN","RCD PRPL2",171 ,0)
  25180    ;
  25181   "RTN","RCD PRPL2",172 ,0)
  25182    ; find us er prefere nce IEN fo r the spec ified entr y (if any)
  25183   "RTN","RCD PRPL2",173 ,0)
  25184    S RCDA=$O (^RC(342.3 ,+$O(^RC(3 42.3,"B",R CSNPT,0)), 1,"B",DUZ, 0))
  25185   "RTN","RCD PRPL2",174 ,0)
  25186    ;
  25187   "RTN","RCD PRPL2",175 ,0)
  25188    ; If the  user has a  preferenc e retrieve  it
  25189   "RTN","RCD PRPL2",176 ,0)
  25190    I RCDA S  RCDA=$P($G (^RC(342.3 ,+$O(^RC(3 42.3,"B",R CSNPT,0)), 1,RCDA,0)) ,U,RCSLDV)
  25191   "RTN","RCD PRPL2",177 ,0)
  25192    Q RCDA
  25193   "RTN","RCD PRPL2",178 ,0)
  25194    ;
  25195   "RTN","RCD PRPL2",179 ,0)
  25196   ASKCUST(OP T,QUES) ;  Ask one of  the custo mize quest ions from  the CUSTOM IZ action
  25197   "RTN","RCD PRPL2",180 ,0)
  25198    ; Input:    OPT - Na me of cust omize opti on to set
  25199   "RTN","RCD PRPL2",181 ,0)
  25200    ;           QUES - Q uestion fo r the user
  25201   "RTN","RCD PRPL2",182 ,0)
  25202    ; Returns : 1 if ans wer 'YES',  0 if answ er 'NO', - 1 if timed  out or '^ '
  25203   "RTN","RCD PRPL2",183 ,0)
  25204    N DIR,DTO UT,DUOUT,X ,Y
  25205   "RTN","RCD PRPL2",184 ,0)
  25206    S DIR(0)= "YO"
  25207   "RTN","RCD PRPL2",185 ,0)
  25208    S DIR("B" )="NO"
  25209   "RTN","RCD PRPL2",186 ,0)
  25210    S:$$OPTCK (OPT,2) DI R("B")="YE S"
  25211   "RTN","RCD PRPL2",187 ,0)
  25212    S DIR("A" )=QUES
  25213   "RTN","RCD PRPL2",188 ,0)
  25214    W !
  25215   "RTN","RCD PRPL2",189 ,0)
  25216    D ^DIR
  25217   "RTN","RCD PRPL2",190 ,0)
  25218    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  25219   "RTN","RCD PRPL2",191 ,0)
  25220    I Y'=-1 D  RCSET(OPT ,Y)  ; PRC A*4.5*332,  fixed OPT  parameter
  25221   "RTN","RCD PRPL2",192 ,0)
  25222    Q Y
  25223   "RTN","RCD PRPL2",193 ,0)
  25224    ;
  25225   "RTN","RCD PRPL2",194 ,0)
  25226   ASKRECT()  ; function , ask user  when they  want to p rint the r eceipt
  25227   "RTN","RCD PRPL2",195 ,0)
  25228    ; Returns : 0 (never ), 1 (alwa ys), 2 (as k), -1 (ti med out or  '^')
  25229   "RTN","RCD PRPL2",196 ,0)
  25230    N DEFAULT ,DIR,DTOUT ,DUOUT,X,Y
  25231   "RTN","RCD PRPL2",197 ,0)
  25232    S DEFAULT ="ALWAYS"
  25233   "RTN","RCD PRPL2",198 ,0)
  25234    I $$OPTCK ("RECEIPT" ,2)'=""!($ $OPTCK("RE CEIPT",3)' ="") D
  25235   "RTN","RCD PRPL2",199 ,0)
  25236    . S DEFAU LT=$$OPTCK ("RECEIPT" ,2),DEFAUL T=$S(DEFAU LT=0:"NEVE R",DEFAULT =1:"ALWAYS ",1:"MAYBE ")
  25237   "RTN","RCD PRPL2",200 ,0)
  25238    S DIR(0)= "SO^0:Neve r Print th e Receipt; 1:Always P rint the R eceipt;2:M aybe, Ask  to Print t he Receipt "
  25239   "RTN","RCD PRPL2",201 ,0)
  25240    S DIR("A" )="Print R eceipt"
  25241   "RTN","RCD PRPL2",202 ,0)
  25242    S DIR("B" )=DEFAULT
  25243   "RTN","RCD PRPL2",203 ,0)
  25244    D ^DIR
  25245   "RTN","RCD PRPL2",204 ,0)
  25246    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  25247   "RTN","RCD PRPL2",205 ,0)
  25248    Q Y
  25249   "RTN","RCD PRPL2",206 ,0)
  25250    ;
  25251   "RTN","RCD PRPL2",207 ,0)
  25252   ASKDEVIC(R CTYPE) ; A sk for the  default p rinter for  receipts  and for 21 5 report
  25253   "RTN","RCD PRPL2",208 ,0)
  25254    ; Input:    RCTYPE -  1 for rec eipts, 2 f or 215 rep ort
  25255   "RTN","RCD PRPL2",209 ,0)
  25256    ; Returns : Name of  selected d evice or " "
  25257   "RTN","RCD PRPL2",210 ,0)
  25258    N RCION
  25259   "RTN","RCD PRPL2",211 ,0)
  25260    S %ZIS="N P0"
  25261   "RTN","RCD PRPL2",212 ,0)
  25262    S %ZIS("A ")="Enter  the Defaul t Printer  for Printi ng Receipt s: "
  25263   "RTN","RCD PRPL2",213 ,0)
  25264    I RCTYPE= 2 S %ZIS(" A")="Enter  the Defau lt Printer  for Print ing the 21 5 Report:  "
  25265   "RTN","RCD PRPL2",214 ,0)
  25266    S %ZIS("B ")=""
  25267   "RTN","RCD PRPL2",215 ,0)
  25268    I RCTYPE= 1,$$OPTCK( "RECEIPT", 3)'="" S % ZIS("B")=$ $OPTCK("RE CEIPT",3)
  25269   "RTN","RCD PRPL2",216 ,0)
  25270    I RCTYPE= 2,$$OPTCK( "215REPORT ",3)'="" S  %ZIS("B") =$$OPTCK(" 215REPORT" ,3)
  25271   "RTN","RCD PRPL2",217 ,0)
  25272    D ^%ZIS
  25273   "RTN","RCD PRPL2",218 ,0)
  25274    I IO=IO(0 ) W !,"You  cannot se lect your  current de vice as a  default pr inter." Q  ""
  25275   "RTN","RCD PRPL2",219 ,0)
  25276    S RCION=I ON
  25277   "RTN","RCD PRPL2",220 ,0)
  25278    ;
  25279   "RTN","RCD PRPL2",221 ,0)
  25280    ; close d evice
  25281   "RTN","RCD PRPL2",222 ,0)
  25282    D ^%ZISC
  25283   "RTN","RCD PRPL2",223 ,0)
  25284    Q RCION
  25285   "RTN","RCD PRPL2",224 ,0)
  25286    ;
  25287   "RTN","RCD PRPL2",225 ,0)
  25288   SHEOB ; Sh ow EEOB de tail if sw itch on -  moved from  RCDPRPLM
  25289   "RTN","RCD PRPL2",226 ,0)
  25290    ; Input:   RCLINE -  Current li ne count
  25291   "RTN","RCD PRPL2",227 ,0)
  25292    ; Output:  RCLINE -  Updated li ne countt
  25293   "RTN","RCD PRPL2",228 ,0)
  25294    I $$OPTCK ("SHOWEOB" ,2) D
  25295   "RTN","RCD PRPL2",229 ,0)
  25296    . N Z S Z =$O(^RCY(3 44.4,"ARCT ",RCRECTDA ,0)) Q:'Z
  25297   "RTN","RCD PRPL2",230 ,0)
  25298    . S RCLIN E=RCLINE+1
  25299   "RTN","RCD PRPL2",231 ,0)
  25300    . D SET^R CDPRPLM("  ",RCLINE,1 ,80)
  25301   "RTN","RCD PRPL2",232 ,0)
  25302    . S RCLIN E=RCLINE+1
  25303   "RTN","RCD PRPL2",233 ,0)
  25304    . D SET^R CDPRPLM("E EOB Detail :",RCLINE, 1,80,0,IOU ON,IOUOFF)
  25305   "RTN","RCD PRPL2",234 ,0)
  25306    . K ^TMP( $J,"RCDISP ")
  25307   "RTN","RCD PRPL2",235 ,0)
  25308    . D DISP^ RCDPEDS(Z)   ; build  ^TMP($J,"R CDISP")
  25309   "RTN","RCD PRPL2",236 ,0)
  25310    . S Z=0 F   S Z=$O(^ TMP($J,"RC DISP",Z))  Q:'Z  D
  25311   "RTN","RCD PRPL2",237 ,0)
  25312    ..  S RCL INE=RCLINE +1
  25313   "RTN","RCD PRPL2",238 ,0)
  25314    ..  D SET ^RCDPRPLM( ^TMP($J,"R CDISP",Z), RCLINE,1,8 0)
  25315   "RTN","RCD PRPL2",239 ,0)
  25316    . K ^TMP( $J,"RCDISP ")
  25317   "RTN","RCD PRPL2",240 ,0)
  25318    Q
  25319   "RTN","RCD PRPL2",241 ,0)
  25320    ;
  25321   "RTN","RCD PRPL4")
  25322   0^32^B3670 7329
  25323   "RTN","RCD PRPL4",1,0 )
  25324   RCDPRPL4 ; WISC/RFJ/P JH-receipt  profile l istmanager  options ; 1 Apr 01
  25325   "RTN","RCD PRPL4",2,0 )
  25326    ;;4.5;Acc ounts Rece ivable;**1 69,172,173 ,269,276,3 26,332**;M ar 20, 199 5;Build 34
  25327   "RTN","RCD PRPL4",3,0 )
  25328    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  25329   "RTN","RCD PRPL4",4,0 )
  25330    Q
  25331   "RTN","RCD PRPL4",5,0 )
  25332    ;
  25333   "RTN","RCD PRPL4",6,0 )
  25334    ;  this r outine con tains the  entry poin ts for rec eipt manag ement
  25335   "RTN","RCD PRPL4",7,0 )
  25336    ;
  25337   "RTN","RCD PRPL4",8,0 )
  25338    ;
  25339   "RTN","RCD PRPL4",9,0 )
  25340   ONLINE ;   allow the  supervisor  to mark t he CR docu ment as in put on lin e
  25341   "RTN","RCD PRPL4",10, 0)
  25342    ;
  25343   "RTN","RCD PRPL4",11, 0)
  25344    ; Input -  RCRECDA -  IEN of CR  receipt i n #344
  25345   "RTN","RCD PRPL4",12, 0)
  25346    ;
  25347   "RTN","RCD PRPL4",13, 0)
  25348    D FULL^VA LM1
  25349   "RTN","RCD PRPL4",14, 0)
  25350    S VALMBCK ="R"
  25351   "RTN","RCD PRPL4",15, 0)
  25352    ;
  25353   "RTN","RCD PRPL4",16, 0)
  25354    ;  get fm s document  and statu s
  25355   "RTN","RCD PRPL4",17, 0)
  25356    N %,FMSDO C,GECSDATA
  25357   "RTN","RCD PRPL4",18, 0)
  25358    S FMSDOC= $$FMSSTAT^ RCDPUREC(R CRECTDA)
  25359   "RTN","RCD PRPL4",19, 0)
  25360    ;
  25361   "RTN","RCD PRPL4",20, 0)
  25362    W !!,"Thi s option w ill allow  you to mar k a reject ed Cash Re ceipt docu ment as"
  25363   "RTN","RCD PRPL4",21, 0)
  25364    W !,"ente red on lin e.  This w ill preven t the docu ment from  being list ed on"
  25365   "RTN","RCD PRPL4",22, 0)
  25366    W !,"the  nightly ma ilman mess age used t o help man age the re ceipts and  deposits. "
  25367   "RTN","RCD PRPL4",23, 0)
  25368    ;
  25369   "RTN","RCD PRPL4",24, 0)
  25370    W !!,"FMS  Cash Rece ipt Docume nt: ",$P(F MSDOC,"^") ,?48,"Stat us: ",$P(F MSDOC,"^", 2)
  25371   "RTN","RCD PRPL4",25, 0)
  25372    ;
  25373   "RTN","RCD PRPL4",26, 0)
  25374    I '$D(^XU SEC("PRCAY  PAYMENT S UP",DUZ))  W !!,"You  are not an  owner of  the superv isor PRCAY  PAYMENT S UP securit y key." D  QUIT Q
  25375   "RTN","RCD PRPL4",27, 0)
  25376    ;
  25377   "RTN","RCD PRPL4",28, 0)
  25378    ;  cr acc epted
  25379   "RTN","RCD PRPL4",29, 0)
  25380    I $E($P(F MSDOC,"^", 2))="A" W  !!,"You CA NNOT mark  the Cash R eceipt doc ument as e ntered on  line.",!," The CR doc ument is A CCEPTED ?? " D QUIT Q
  25381   "RTN","RCD PRPL4",30, 0)
  25382    ;
  25383   "RTN","RCD PRPL4",31, 0)
  25384    ;  not be en transmi tted for 2  days
  25385   "RTN","RCD PRPL4",32, 0)
  25386    I $E($P(F MSDOC,"^", 2))="T",$$ FMDIFF^XLF DT(DT,$P(^ RCY(344,RC RECTDA,0), "^",8))'>2  W !!,"You  CANNOT ma rk the Cas h Receipt  document a s entered  on line.", !,"The CR  document h as NOT bee n TRANSMIT TED for 2  days ??" D  QUIT Q
  25387   "RTN","RCD PRPL4",33, 0)
  25388    ;
  25389   "RTN","RCD PRPL4",34, 0)
  25390    ;  cr que ued for tr ansmission
  25391   "RTN","RCD PRPL4",35, 0)
  25392    I $E($P(F MSDOC,"^", 2))="Q"!($ E($P(FMSDO C,"^",2))= "M") W !!, "You CANNO T mark the  Cash Rece ipt docume nt as ente red on lin e.",!,"The  CR docume nt is wait ing to be  TRANSMITTE D ??" D QU IT Q
  25393   "RTN","RCD PRPL4",36, 0)
  25394    ;
  25395   "RTN","RCD PRPL4",37, 0)
  25396    ;  check  to see if  already ma rked as en tered on l ine
  25397   "RTN","RCD PRPL4",38, 0)
  25398    I $E($P(F MSDOC,"^", 2))="O" D   Q
  25399   "RTN","RCD PRPL4",39, 0)
  25400    .   I $$A SKSTAT("RE MOVE")'=1  Q
  25401   "RTN","RCD PRPL4",40, 0)
  25402    .   W !," ... removi ng CR stat us as ente red on lin e ..."
  25403   "RTN","RCD PRPL4",41, 0)
  25404    .   ;  re move the O N-LINE sta tus on fie ld 201
  25405   "RTN","RCD PRPL4",42, 0)
  25406    .   D EDI TREC^RCDPU REC(RCRECT DA,"201/// 0")
  25407   "RTN","RCD PRPL4",43, 0)
  25408    .   ;  sh ow the new  status
  25409   "RTN","RCD PRPL4",44, 0)
  25410    .   S FMS DOC=$$FMSS TAT^RCDPUR EC(RCRECTD A)
  25411   "RTN","RCD PRPL4",45, 0)
  25412    .   W !!, "FMS Cash  Receipt Do cument: ", $P(FMSDOC, "^"),?48," Status: ", $P(FMSDOC, "^",2)
  25413   "RTN","RCD PRPL4",46, 0)
  25414    .   D QUI T
  25415   "RTN","RCD PRPL4",47, 0)
  25416    ;
  25417   "RTN","RCD PRPL4",48, 0)
  25418    ;  ask to  change th e status t o entered  on line
  25419   "RTN","RCD PRPL4",49, 0)
  25420    I $$ASKST AT("ENTER" )'=1 D QUI T Q
  25421   "RTN","RCD PRPL4",50, 0)
  25422    ;
  25423   "RTN","RCD PRPL4",51, 0)
  25424    ;  change  the statu s to enter ed on line
  25425   "RTN","RCD PRPL4",52, 0)
  25426    W !!,"...  changing  status to  entered on  line ..."
  25427   "RTN","RCD PRPL4",53, 0)
  25428    W !,"...  changing t he generic  code shee t stack fi le status  to ACCEPTE D ..."
  25429   "RTN","RCD PRPL4",54, 0)
  25430    ;
  25431   "RTN","RCD PRPL4",55, 0)
  25432    ;  set th e status t o entered  on line in  field 201
  25433   "RTN","RCD PRPL4",56, 0)
  25434    D EDITREC ^RCDPUREC( RCRECTDA," 201///1")
  25435   "RTN","RCD PRPL4",57, 0)
  25436    ;
  25437   "RTN","RCD PRPL4",58, 0)
  25438    ;  set th e generic  code sheet  status as  accepted
  25439   "RTN","RCD PRPL4",59, 0)
  25440    ;  get th e document  ien
  25441   "RTN","RCD PRPL4",60, 0)
  25442    D DATA^GE CSSGET($P( FMSDOC,"^" ))
  25443   "RTN","RCD PRPL4",61, 0)
  25444    I $G(GECS DATA) D SE TSTAT^GECS STAA(GECSD ATA,"A")
  25445   "RTN","RCD PRPL4",62, 0)
  25446    ;
  25447   "RTN","RCD PRPL4",63, 0)
  25448    ;  show t he new sta tus
  25449   "RTN","RCD PRPL4",64, 0)
  25450    S FMSDOC= $$FMSSTAT^ RCDPUREC(R CRECTDA)
  25451   "RTN","RCD PRPL4",65, 0)
  25452    W !!,"FMS  Cash Rece ipt Docume nt: ",$P(F MSDOC,"^") ,?48,"Stat us: ",$P(F MSDOC,"^", 2)
  25453   "RTN","RCD PRPL4",66, 0)
  25454    ;
  25455   "RTN","RCD PRPL4",67, 0)
  25456   QUIT ;  pa use and re build the  header
  25457   "RTN","RCD PRPL4",68, 0)
  25458    W !!,"pre ss RETURN  to continu e: "
  25459   "RTN","RCD PRPL4",69, 0)
  25460    R %:DTIME
  25461   "RTN","RCD PRPL4",70, 0)
  25462    D HDR^RCD PRPLM
  25463   "RTN","RCD PRPL4",71, 0)
  25464    Q
  25465   "RTN","RCD PRPL4",72, 0)
  25466    ;
  25467   "RTN","RCD PRPL4",73, 0)
  25468    ;
  25469   "RTN","RCD PRPL4",74, 0)
  25470   ASKSTAT(AC TION) ;  a sk if its  okay to re move or ch ange the e ntered onl ine status
  25471   "RTN","RCD PRPL4",75, 0)
  25472    ;  1 is y es, otherw ise no
  25473   "RTN","RCD PRPL4",76, 0)
  25474    N DIR,DIQ 2,DTOUT,DU OUT,X,Y
  25475   "RTN","RCD PRPL4",77, 0)
  25476    S DIR(0)= "YO",DIR(" B")="NO"
  25477   "RTN","RCD PRPL4",78, 0)
  25478    S DIR("A" ,1)="  Do  you want t o "_ACTION _" the sta tus showin g the Cash  Receipt"
  25479   "RTN","RCD PRPL4",79, 0)
  25480    S DIR("A" )="  docum ent was en tered ON L INE"
  25481   "RTN","RCD PRPL4",80, 0)
  25482    D ^DIR
  25483   "RTN","RCD PRPL4",81, 0)
  25484    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  25485   "RTN","RCD PRPL4",82, 0)
  25486    Q Y
  25487   "RTN","RCD PRPL4",83, 0)
  25488    ;
  25489   "RTN","RCD PRPL4",84, 0)
  25490   ERAWL(RCSC R) ; Gener ate automa tic dec ad j from ERA  Worklist  in RCSCR
  25491   "RTN","RCD PRPL4",85, 0)
  25492    ; RCADJ r eturned =  1 if passe d by refer ence and a djustment  successful
  25493   "RTN","RCD PRPL4",86, 0)
  25494    ;       r eturned =  2 if passe d by ref a nd adjustm ents abort ed
  25495   "RTN","RCD PRPL4",87, 0)
  25496    ;       r eturned =  -1 if erro r
  25497   "RTN","RCD PRPL4",88, 0)
  25498    ;       r eturned =  0 if no WL  adjustmen ts found
  25499   "RTN","RCD PRPL4",89, 0)
  25500    N RCZ,RCZ 0,Z00,V00, RCCOM,RC1, RCADJ,RCOK ,WLA
  25501   "RTN","RCD PRPL4",90, 0)
  25502    S RC1=1,R CZ=0,RCADJ =0
  25503   "RTN","RCD PRPL4",91, 0)
  25504    F  S RCZ= $O(^RCY(34 4.49,RCSCR ,1,RCZ)) Q :'RCZ!(RCA DJ=2)  S V 00=$G(^(RC Z,0)),RCZ0 =0 F  S RC Z0=$O(^RCY (344.49,RC SCR,1,RCZ, 1,RCZ0)) Q :'RCZ0!(RC ADJ=2)  S  Z00=$G(^(R CZ0,0)) Q: "12"'[+$P( Z00,U,5)   D
  25505   "RTN","RCD PRPL4",92, 0)
  25506    . S RCCOM (1)=$P(Z00 ,U,9)
  25507   "RTN","RCD PRPL4",93, 0)
  25508    . I RC1,$ P(Z00,U,5) =1 D  Q:RC ADJ=2
  25509   "RTN","RCD PRPL4",94, 0)
  25510    .. S RC1= 0
  25511   "RTN","RCD PRPL4",95, 0)
  25512    .. S DIR( 0)="YA",DI R("B")="YE S",DIR("A" ,1)="Gener ating auto matic decr ease adjus tments fro m EDI Lbox  Worklist  ...",DIR(" A")="ARE Y OU SURE YO U WANT TO  CONTINUE?:  "
  25513   "RTN","RCD PRPL4",96, 0)
  25514    .. D ^DIR  K DIR
  25515   "RTN","RCD PRPL4",97, 0)
  25516    .. I Y'=1  S RCADJ=2
  25517   "RTN","RCD PRPL4",98, 0)
  25518    . I $P(Z0 0,U,8)=1 D   Q  ; pre viously do ne
  25519   "RTN","RCD PRPL4",99, 0)
  25520    .. I $P(Z 00,U,5)=1  W !,"  Aut omatic dec rease adj  from ERA W orklist fo r bill #"_ $P($G(^PRC A(430,+$P( V00,U,7),0 )),U),!,"     for amo unt of "_$ J(+$P(Z00, U,3),"",2) _" was pre viously co mpleted" S  RCADJ=1
  25521   "RTN","RCD PRPL4",100 ,0)
  25522    . I $P(Z0 0,U,5)=1 D   Q  ; Dec rease adj
  25523   "RTN","RCD PRPL4",101 ,0)
  25524    .. S WLA= $$INCDEC^R CBEUTR1($P (V00,U,7), $P(Z00,U,3 ),.RCCOM,, ,1) I 'WLA  D
  25525   "RTN","RCD PRPL4",102 ,0)
  25526    ... ; PRC A276 - $$I NCDEC can  now return  "0^1" whi ch means a  negative  claim bala nce could  have occur red if the  decrease  adjustment  was appli ed to the  claim
  25527   "RTN","RCD PRPL4",103 ,0)
  25528    ... S RCA DJ=-1 W !, "  Could n ot perform  automatic  decrease  adj from E RA Worklis t for ",!, "    bill  # "_$P($G( ^PRCA(430, +$P(V00,U, 7),0)),U)_ " for amou nt of "_$J (+$P(Z00,U ,3),"",2)
  25529   "RTN","RCD PRPL4",104 ,0)
  25530    ... I $P( WLA,U,2) D
  25531   "RTN","RCD PRPL4",105 ,0)
  25532    .... S RC ADJ=2
  25533   "RTN","RCD PRPL4",106 ,0)
  25534    .... W !, "WARNING:   Receipt c annot be p rocessed." ,!,"Proces sing this  receipt wi ll cause t his bill t o have a n egative ba lance",!," which is o utside the  scope of  VA Account ing regula tions."
  25535   "RTN","RCD PRPL4",107 ,0)
  25536    .... W !, "Correct t he error a nd reproce ss this re ceipt."
  25537   "RTN","RCD PRPL4",108 ,0)
  25538    .. E  D   ; success
  25539   "RTN","RCD PRPL4",109 ,0)
  25540    ... D UPD (RCSCR,RCZ ,RCZ0)
  25541   "RTN","RCD PRPL4",110 ,0)
  25542    ... S RCA DJ=1
  25543   "RTN","RCD PRPL4",111 ,0)
  25544    ... W !,"   EDI Lbox  Worklist  automatic  dec adjust ment made  to "_$P($G (^PRCA(430 ,+$P(V00,U ,7),0)),U) _": "_$J(+ $P(Z00,U,3 ),"",2)
  25545   "RTN","RCD PRPL4",112 ,0)
  25546    . I $P(Z0 0,U,5)=2 D   Q  ; Bil l comment
  25547   "RTN","RCD PRPL4",113 ,0)
  25548    .. D ADDC OMM^RCBEUT RA($P(V00, U,7),.RCCO M),UPD(RCS CR,RCZ,RCZ 0)
  25549   "RTN","RCD PRPL4",114 ,0)
  25550    ;
  25551   "RTN","RCD PRPL4",115 ,0)
  25552    Q $G(RCAD J)
  25553   "RTN","RCD PRPL4",116 ,0)
  25554    ;
  25555   "RTN","RCD PRPL4",117 ,0)
  25556   UPD(RCSCR, Z,Z0) ; Ma rk as comp lete so it  doesn't g et done tw ice
  25557   "RTN","RCD PRPL4",118 ,0)
  25558    N DA,DIE, DR
  25559   "RTN","RCD PRPL4",119 ,0)
  25560    S DA(2)=R CSCR,DA(1) =Z,DA=Z0
  25561   "RTN","RCD PRPL4",120 ,0)
  25562    S DIE="^R CY(344.49, "_DA(2)_", 1,"_DA(1)_ ",1,",DR=" .08////1"  D ^DIE
  25563   "RTN","RCD PRPL4",121 ,0)
  25564    Q
  25565   "RTN","RCD PRPL4",122 ,0)
  25566    ;
  25567   "RTN","RCD PRPLM")
  25568   0^33^B1011 19693
  25569   "RTN","RCD PRPLM",1,0 )
  25570   RCDPRPLM ;  WISC/RFJ- receipt pr ofile List  Manager m ain routin e ;31 Oct  2018 09:14 :14
  25571   "RTN","RCD PRPLM",2,0 )
  25572    ;;4.5;Acc ounts Rece ivable;**1 14,148,149 ,173,196,2 20,217,321 ,326,332** ;Mar 20, 1 995;Build  34
  25573   "RTN","RCD PRPLM",3,0 )
  25574    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  25575   "RTN","RCD PRPLM",4,0 )
  25576    ;
  25577   "RTN","RCD PRPLM",5,0 )
  25578    ; option:  Receipt P rocessing  [RCDP RECE IPT PROCES SING]
  25579   "RTN","RCD PRPLM",6,0 )
  25580    N RCDPFXI T
  25581   "RTN","RCD PRPLM",7,0 )
  25582    ;
  25583   "RTN","RCD PRPLM",8,0 )
  25584   RECTPROF ; EP from RE CEIPT^RCDP LPL1
  25585   "RTN","RCD PRPLM",9,0 )
  25586    ; Entry p oint calle d by link  payment to  prevent N EWing fast  exit var  RCDPFXIT
  25587   "RTN","RCD PRPLM",10, 0)
  25588    N RCRECTD A
  25589   "RTN","RCD PRPLM",11, 0)
  25590    ;
  25591   "RTN","RCD PRPLM",12, 0)
  25592    F  D  Q:' RCRECTDA
  25593   "RTN","RCD PRPLM",13, 0)
  25594    . W !! S  RCRECTDA=$ $SELRECT^R CDPUREC(1)   ; Allow  adding new  receipt
  25595   "RTN","RCD PRPLM",14, 0)
  25596    . I RCREC TDA<1 S RC RECTDA=0 Q
  25597   "RTN","RCD PRPLM",15, 0)
  25598    . D EN^VA LM("RCDP R ECEIPT PRO FILE")
  25599   "RTN","RCD PRPLM",16, 0)
  25600    . I $G(RC DPFXIT) S  RCRECTDA=0   ; Fast e xit
  25601   "RTN","RCD PRPLM",17, 0)
  25602    Q
  25603   "RTN","RCD PRPLM",18, 0)
  25604    ;
  25605   "RTN","RCD PRPLM",19, 0)
  25606   INIT ;EP f rom ListMa n template  RCDP RECE IPT PROFIL E MENU
  25607   "RTN","RCD PRPLM",20, 0)
  25608    ; EP from  CUSTOMIZ^ RCDPRPL2
  25609   "RTN","RCD PRPLM",21, 0)
  25610    ; Initial ization fo r list man ager
  25611   "RTN","RCD PRPLM",22, 0)
  25612    ; Input:    RCRECTDA     - IEN  for the se lected rec eipt (#344 )
  25613   "RTN","RCD PRPLM",23, 0)
  25614    N DATE,EF TFUND,FMSD OC,GECSDA1 ,GECSDATA, RCCANCEL,R CEFT,RCDPD ATA,RCDPFC AN,RCLINE, RCTOTAL,RC TRDA
  25615   "RTN","RCD PRPLM",24, 0)
  25616    N RCZ,RCZ 0,RCZ1,RCZ 2,X,XX,Z,Z 0
  25617   "RTN","RCD PRPLM",25, 0)
  25618    K ^TMP("R CDPRPLM",$ J),^TMP("V ALM VIDEO" ,$J)
  25619   "RTN","RCD PRPLM",26, 0)
  25620    I $G(RCDP FXIT) S VA LMQUIT=1 Q   ; Fast e xit
  25621   "RTN","RCD PRPLM",27, 0)
  25622    D DIQ344( RCRECTDA," .02:200")
  25623   "RTN","RCD PRPLM",28, 0)
  25624    S RCLINE= 0  ; list  manager li ne #
  25625   "RTN","RCD PRPLM",29, 0)
  25626    K ^TMP($J ,"RCEFT")
  25627   "RTN","RCD PRPLM",30, 0)
  25628    S EFTFUND =$S(DT<$$A DDPTEDT^PR CAACC():"5 287.4/8NZZ  ",1:"5287 04/8NZZ ")
  25629   "RTN","RCD PRPLM",31, 0)
  25630    S RCEFT=+ $O(^RCY(34 4.3,"ARDEP ",+$P($G(^ RCY(344,RC RECTDA,0)) ,U,6),0))
  25631   "RTN","RCD PRPLM",32, 0)
  25632    I RCEFT D
  25633   "RTN","RCD PRPLM",33, 0)
  25634    . S Z=0 F   S Z=$O(^ RCY(344.31 ,"B",RCEFT ,Z)) Q:'Z   D
  25635   "RTN","RCD PRPLM",34, 0)
  25636    ..  S Z0= $G(^RCY(34 4.31,+Z,0) )
  25637   "RTN","RCD PRPLM",35, 0)
  25638    ..  I $P( Z0,U,14) S  ^TMP($J," RCEFT",$P( Z0,U,14))= Z_U_$E($P( Z0,U,2),1, 12)
  25639   "RTN","RCD PRPLM",36, 0)
  25640    ;
  25641   "RTN","RCD PRPLM",37, 0)
  25642    S RCTRDA= 0
  25643   "RTN","RCD PRPLM",38, 0)
  25644    F  S RCTR DA=$O(^RCY (344,RCREC TDA,1,RCTR DA)) Q:'RC TRDA  D
  25645   "RTN","RCD PRPLM",39, 0)
  25646    . D DIQ34 401(RCRECT DA,RCTRDA)
  25647   "RTN","RCD PRPLM",40, 0)
  25648    . S RCLIN E=RCLINE+1  D SET("", RCLINE,1,8 0,.01)
  25649   "RTN","RCD PRPLM",41, 0)
  25650    . ; Check  for payme nt cancell ed
  25651   "RTN","RCD PRPLM",42, 0)
  25652    . S RCCAN CEL=0
  25653   "RTN","RCD PRPLM",43, 0)
  25654    . I $P($G (^RCY(344, RCRECTDA,1 ,RCTRDA,0) ),"^",4)=0 ,$P($G(^(1 )),"^")'=" " D
  25655   "RTN","RCD PRPLM",44, 0)
  25656    ..  S RCC ANCEL=1,RC DPFCAN=1 D  SET("**", RCLINE,5,6 )
  25657   "RTN","RCD PRPLM",45, 0)
  25658    . ; Accou nt
  25659   "RTN","RCD PRPLM",46, 0)
  25660    . I $G(RC DPDATA(344 .01,RCTRDA ,.03,"E")) ="" D
  25661   "RTN","RCD PRPLM",47, 0)
  25662    ..  S:RCE FT XX=EFTF UND_$P($G( ^TMP($J,"R CEFT",RCTR DA)),U,2)
  25663   "RTN","RCD PRPLM",48, 0)
  25664    ..  S:'RC EFT XX=$$G ETUNAPP^RC XFMSCR(RCR ECTDA,RCTR DA,0)
  25665   "RTN","RCD PRPLM",49, 0)
  25666    ..  S RCD PDATA(344. 01,RCTRDA, .03,"E")=" [ "_XX_" ] "
  25667   "RTN","RCD PRPLM",50, 0)
  25668    . D SET(" ",RCLINE,7 ,33,.03)
  25669   "RTN","RCD PRPLM",51, 0)
  25670    . ; (#.06 ) DATE OF  PAYMENT [6 D]
  25671   "RTN","RCD PRPLM",52, 0)
  25672    . S X=RCD PDATA(344. 01,RCTRDA, .06,"I") D :X
  25673   "RTN","RCD PRPLM",53, 0)
  25674    ..  S XX= $E(X,4,5)_ "/"_$E(X,6 ,7)_"/"_$E (X,2,3) D  SET(XX,RCL INE,35,42)
  25675   "RTN","RCD PRPLM",54, 0)
  25676    . ;( #.12 ) ENTERED  BY [12P:20 0]
  25677   "RTN","RCD PRPLM",55, 0)
  25678    . S X=RCD PDATA(344. 01,RCTRDA, .12,"E") D :$L(X)
  25679   "RTN","RCD PRPLM",56, 0)
  25680    ..  ; if  POSTMASTER  set to 'a r' else us er's initi als
  25681   "RTN","RCD PRPLM",57, 0)
  25682    ..  S X=$ S(RCDPDATA (344.01,RC TRDA,.12," I")=.5:"ar ",1:$E($P( X,",",2))_ $E(X))
  25683   "RTN","RCD PRPLM",58, 0)
  25684    ..  D SET (X,RCLINE, 45,46)
  25685   "RTN","RCD PRPLM",59, 0)
  25686    . ;(#.14)  EDITED BY  [14P:200]
  25687   "RTN","RCD PRPLM",60, 0)
  25688    . S X=RCD PDATA(344. 01,RCTRDA, .14,"E")'= "" D:$L(X)
  25689   "RTN","RCD PRPLM",61, 0)
  25690    ..  S X=$ E($P(X,"," ,2))_$E(X)  D SET(X,R CLINE,54,5 5)
  25691   "RTN","RCD PRPLM",62, 0)
  25692    . D SET($ J(RCDPDATA (344.01,RC TRDA,.04," E"),8,2),R CLINE,62,7 0)  ; (#.0 4) PAYMENT  AMOUNT [4 N]
  25693   "RTN","RCD PRPLM",63, 0)
  25694    . D SET($ J(RCDPDATA (344.01,RC TRDA,.05," E"),8,2),R CLINE,72,8 0)  ; (#.0 5) AMOUNT  PROCESSED  [5N]
  25695   "RTN","RCD PRPLM",64, 0)
  25696    . ;
  25697   "RTN","RCD PRPLM",65, 0)
  25698    . ; If no t processe d, show if  amount >  bill
  25699   "RTN","RCD PRPLM",66, 0)
  25700    . S X=$$C HECKPAY^RC DPRPL3(RCR ECTDA,RCTR DA) D:X
  25701   "RTN","RCD PRPLM",67, 0)
  25702    ..  S XX= "  WARNING : Pending  Payments ( $ "_$J($P( X,"^",3),0 ,2)_") exc eed amount  billed ($  "_$J($P(X ,"^",2),0, 2)_")"
  25703   "RTN","RCD PRPLM",68, 0)
  25704    ..  S RCL INE=RCLINE +1 D SET(X X,RCLINE,1 ,80)
  25705   "RTN","RCD PRPLM",69, 0)
  25706    . ; Show  line 2 for  check/cre dit paymen t
  25707   "RTN","RCD PRPLM",70, 0)
  25708    . I $$OPT CK^RCDPRPL 2("SHOWCHE CK",2) D
  25709   "RTN","RCD PRPLM",71, 0)
  25710    ..  ; Rec eipt type  is check
  25711   "RTN","RCD PRPLM",72, 0)
  25712    ..  I RCD PDATA(344, RCRECTDA,. 04,"I")=4! (RCDPDATA( 344,RCRECT DA,.04,"I" )=12) D  Q
  25713   "RTN","RCD PRPLM",73, 0)
  25714    ...   S R CLINE=RCLI NE+1 D SET ("      Ch eck #",RCL INE,1,80,. 07)
  25715   "RTN","RCD PRPLM",74, 0)
  25716    ...   S X =RCDPDATA( 344.01,RCT RDA,.1,"I" ) S:'X X=" ???????"
  25717   "RTN","RCD PRPLM",75, 0)
  25718    ...   S X X="Date: " _$E(X,4,5) _"/"_$E(X, 6,7)_"/"_$ E(X,2,3) D  SET(XX,RC LINE,32,80 )
  25719   "RTN","RCD PRPLM",76, 0)
  25720    ...   D S ET("Bank # ",RCLINE,4 7,80,.08)
  25721   "RTN","RCD PRPLM",77, 0)
  25722    ..  ; Rec eipt type  of payment  is credit
  25723   "RTN","RCD PRPLM",78, 0)
  25724    ..  I RCD PDATA(344, RCRECTDA,. 04,"I")=7  D  Q
  25725   "RTN","RCD PRPLM",79, 0)
  25726    ...   S R CLINE=RCLI NE+1 D SET ("      Ca rd #",RCLI NE,1,80,.1 1),SET("Co nfirmation  #",RCLINE ,35,80,.02 )
  25727   "RTN","RCD PRPLM",80, 0)
  25728    ..  ; typ e of payme nt is EDI  LOCKBOX
  25729   "RTN","RCD PRPLM",81, 0)
  25730    ..  I RCD PDATA(344, RCRECTDA,. 04,"I")=14  D  Q
  25731   "RTN","RCD PRPLM",82, 0)
  25732    ...   S R CLINE=RCLI NE+1 D SET ("      Tr ace #",RCL INE,1,80,. 17)
  25733   "RTN","RCD PRPLM",83, 0)
  25734    . ; line  3 for acct . lookup,  batch #, s equence #
  25735   "RTN","RCD PRPLM",84, 0)
  25736    . I $$OPT CK^RCDPRPL 2("SHOWACC T",2) D
  25737   "RTN","RCD PRPLM",85, 0)
  25738    ..  N TRN S  ; trans action inf o
  25739   "RTN","RCD PRPLM",86, 0)
  25740    ..  S TRN S("acctLku p")=RCDPDA TA(344.01, RCTRDA,.21 ,"E")  ; ( #.21) ACCO UNT LOOKUP  [1F]
  25741   "RTN","RCD PRPLM",87, 0)
  25742    ..  S TRN S("btch#") =RCDPDATA( 344.01,RCT RDA,.22,"E ")  ; (#.2 2) BATCH N UMBER [2N]
  25743   "RTN","RCD PRPLM",88, 0)
  25744    ..  S TRN S("sq#")=R CDPDATA(34 4.01,RCTRD A,.23,"E")   ; (#.23)  SEQUENCE  NUMBER [3N ]
  25745   "RTN","RCD PRPLM",89, 0)
  25746    ..  I TRN S("acctLku p")="",TRN S("btch#") ="",TRNS(" sq#")="" Q   ; No Acc ount infor mation, sk ip
  25747   "RTN","RCD PRPLM",90, 0)
  25748    ..  S RCL INE=RCLINE +1
  25749   "RTN","RCD PRPLM",91, 0)
  25750    ..  D SET ("      Ac ctLU",RCLI NE,1,80,.2 1),SET("Ba tch/Sequen ce: "_TRNS ("btch#")_ "/"_TRNS(" sq#"),RCLI NE,37,80)
  25751   "RTN","RCD PRPLM",92, 0)
  25752    . ; Show  if posting  error
  25753   "RTN","RCD PRPLM",93, 0)
  25754    . I $$OPT CK^RCDPRPL 2("SHOWCOM MENTS",2), RCDPDATA(3 44.01,RCTR DA,1.01,"E ")'="" D
  25755   "RTN","RCD PRPLM",94, 0)
  25756    ..  S X=$ S(RCCANCEL :"Cancel D ata",1:"Po sting Erro r")
  25757   "RTN","RCD PRPLM",95, 0)
  25758    ..  S RCL INE=RCLINE +1 D SET("       "_X, RCLINE,1,8 0,1.01)
  25759   "RTN","RCD PRPLM",96, 0)
  25760    . ; Show  if comment
  25761   "RTN","RCD PRPLM",97, 0)
  25762    . I $$OPT CK^RCDPRPL 2("SHOWCOM MENTS",2), RCDPDATA(3 44.01,RCTR DA,1.02,"E ")'="" D
  25763   "RTN","RCD PRPLM",98, 0)
  25764    ..  S RCL INE=RCLINE +1 D SET("       Comm ent",RCLIN E,1,80,1.0 2)
  25765   "RTN","RCD PRPLM",99, 0)
  25766    . ; If ED I Lockbox  pending ad justments,  show it
  25767   "RTN","RCD PRPLM",100 ,0)
  25768    . I $P($G (^RCY(344, RCRECTDA,0 )),U,18),$ G(RCDPDATA (344.01,RC TRDA,.27," E")) D
  25769   "RTN","RCD PRPLM",101 ,0)
  25770    ..  S RCZ =$P(^RCY(3 44,RCRECTD A,0),U,18) ,RCZ0=RCDP DATA(344.0 1,RCTRDA,. 27,"E")
  25771   "RTN","RCD PRPLM",102 ,0)
  25772    ..  S RCZ 1=0 F  S R CZ1=$O(^RC Y(344.49,R CZ,1,RCZ0, 1,RCZ1)) Q :'RCZ1  S  RCZ2=$G(^( RCZ1,0)) D
  25773   "RTN","RCD PRPLM",103 ,0)
  25774    ...   I $ P(RCZ2,U,5 )'="","12" [$P(RCZ2,U ,5),'$P(RC Z2,U,8) D
  25775   "RTN","RCD PRPLM",104 ,0)
  25776    ....    I  $P(RCZ2,U ,5)=1 D  Q
  25777   "RTN","RCD PRPLM",105 ,0)
  25778    .....      S RCLINE= RCLINE+1 D  SET("       Pending  decrease a djustment  for "_$J($ P(RCZ2,U,3 ),"",2),RC LINE,1,80)
  25779   "RTN","RCD PRPLM",106 ,0)
  25780    ....    I  $$OPTCK^R CDPRPL2("S HOWCOMMENT S",2),$P(R CZ2,U,5)=2  D  Q
  25781   "RTN","RCD PRPLM",107 ,0)
  25782    .....      S RCLINE= RCLINE+1 D  SET("       Comment:  "_$P(RCZ2 ,U,9),RCLI NE,1,80)
  25783   "RTN","RCD PRPLM",108 ,0)
  25784    . ; Calcu late total s
  25785   "RTN","RCD PRPLM",109 ,0)
  25786    . S RCTOT AL(1)=$G(R CTOTAL(1)) +RCDPDATA( 344.01,RCT RDA,.04,"E ")
  25787   "RTN","RCD PRPLM",110 ,0)
  25788    . S RCTOT AL(2)=$G(R CTOTAL(2)) +RCDPDATA( 344.01,RCT RDA,.05,"E ")
  25789   "RTN","RCD PRPLM",111 ,0)
  25790    . ; clean up
  25791   "RTN","RCD PRPLM",112 ,0)
  25792    . K RCDPD ATA(344.01 ,RCTRDA)
  25793   "RTN","RCD PRPLM",113 ,0)
  25794    ;
  25795   "RTN","RCD PRPLM",114 ,0)
  25796    ; Show to tals
  25797   "RTN","RCD PRPLM",115 ,0)
  25798    K ^TMP($J ,"RCEFT")
  25799   "RTN","RCD PRPLM",116 ,0)
  25800    S RCLINE= RCLINE+1 D  SET("",RC LINE,1,80) ,SET("---- ----  ---- ----",RCLI NE,62,80)
  25801   "RTN","RCD PRPLM",117 ,0)
  25802    S RCLINE= RCLINE+1 D  SET("       TOTAL DO LLARS FOR  RECEIPT",R CLINE,1,80 )
  25803   "RTN","RCD PRPLM",118 ,0)
  25804    D SET($J( $G(RCTOTAL (1)),8,2), RCLINE,62, 70)
  25805   "RTN","RCD PRPLM",119 ,0)
  25806    D SET($J( $G(RCTOTAL (2)),8,2), RCLINE,72, 80)
  25807   "RTN","RCD PRPLM",120 ,0)
  25808    ;
  25809   "RTN","RCD PRPLM",121 ,0)
  25810    ; Show ca ncelled
  25811   "RTN","RCD PRPLM",122 ,0)
  25812    I $G(RCDP FCAN) S RC LINE=RCLIN E+1 D SET( "**indicat es payment  is CANCEL LED",RCLIN E,5,80)
  25813   "RTN","RCD PRPLM",123 ,0)
  25814    ;
  25815   "RTN","RCD PRPLM",124 ,0)
  25816    ; Show hi story
  25817   "RTN","RCD PRPLM",125 ,0)
  25818    S RCLINE= RCLINE+1 D  SET(" ",R CLINE,1,80 )
  25819   "RTN","RCD PRPLM",126 ,0)
  25820    ;
  25821   "RTN","RCD PRPLM",127 ,0)
  25822    ; Start h istory on  first line  of a scre en if it d oes not fi t on curre nt screen
  25823   "RTN","RCD PRPLM",128 ,0)
  25824    I (RCLINE #12)>8 F X =(RCLINE#1 2):1:12 S  RCLINE=RCL INE+1 D SE T(" ",RCLI NE,1,80)
  25825   "RTN","RCD PRPLM",129 ,0)
  25826    S RCLINE= RCLINE+1 D  SET("Rece ipt Histor y",RCLINE, 1,80,0,IOU ON,IOUOFF)
  25827   "RTN","RCD PRPLM",130 ,0)
  25828    S DATE=RC DPDATA(344 ,RCRECTDA, .03,"E"),D ATE=$P(DAT E,"@")_"   "_$P($P(DA TE,"@",2), ":",1,2)
  25829   "RTN","RCD PRPLM",131 ,0)
  25830    I RCDPDAT A(344,RCRE CTDA,.02," I")=.5 S R CDPDATA(34 4,RCRECTDA ,.02,"E")= "accounts  receivable "
  25831   "RTN","RCD PRPLM",132 ,0)
  25832    S XX=$E("    Opened  By: "_RCDP DATA(344,R CRECTDA,.0 2,"E")_$$S P,1,39)_"D ate/Time     Opened:  "_DATE
  25833   "RTN","RCD PRPLM",133 ,0)
  25834    S RCLINE= RCLINE+1 D  SET(XX,RC LINE,1,80)
  25835   "RTN","RCD PRPLM",134 ,0)
  25836    ; (#.12)  DATE/TIME  LAST EDIT  [12D]
  25837   "RTN","RCD PRPLM",135 ,0)
  25838    S DATE=RC DPDATA(344 ,RCRECTDA, .12,"E"),D ATE=$P(DAT E,"@")_"   "_$P($P(DA TE,"@",2), ":",1,2)
  25839   "RTN","RCD PRPLM",136 ,0)
  25840    S X=RCDPD ATA(344,RC RECTDA,.11 ,"E") I RC DPDATA(344 ,RCRECTDA, .11,"I")=. 5 S X="acc ounts rece ivable"
  25841   "RTN","RCD PRPLM",137 ,0)
  25842    S XX=$E(" Last Edit  By: "_X_$$ SP,1,39)_" Date/Time  Last Edit:  "_DATE
  25843   "RTN","RCD PRPLM",138 ,0)
  25844    S RCLINE= RCLINE+1 D  SET(XX,RC LINE,1,80)
  25845   "RTN","RCD PRPLM",139 ,0)
  25846    ; (#.08)  DATE/TIME  PROCESSED  [8D]
  25847   "RTN","RCD PRPLM",140 ,0)
  25848    S DATE=RC DPDATA(344 ,RCRECTDA, .08,"E"),D ATE=$P(DAT E,"@")_"   "_$P($P(DA TE,"@",2), ":",1,2)
  25849   "RTN","RCD PRPLM",141 ,0)
  25850    I RCDPDAT A(344,RCRE CTDA,.07," I")=.5 S R CDPDATA(34 4,RCRECTDA ,.07,"E")= "accounts  receivable "
  25851   "RTN","RCD PRPLM",142 ,0)
  25852    S XX=$E(" Processed  By: "_RCDP DATA(344,R CRECTDA,.0 7,"E")_$$S P,1,39)_"D ate/Time P rocessed:  "_DATE
  25853   "RTN","RCD PRPLM",143 ,0)
  25854    S RCLINE= RCLINE+1 D  SET(XX,RC LINE,1,80)
  25855   "RTN","RCD PRPLM",144 ,0)
  25856    ;
  25857   "RTN","RCD PRPLM",145 ,0)
  25858    ; Show FM S code she ets if swi tch on in  file 342.3
  25859   "RTN","RCD PRPLM",146 ,0)
  25860    I $$OPTCK ^RCDPRPL2( "SHOWFMS", 2) D
  25861   "RTN","RCD PRPLM",147 ,0)
  25862    . S FMSDO C=$$FMSSTA T^RCDPUREC (RCRECTDA)
  25863   "RTN","RCD PRPLM",148 ,0)
  25864    . S RCLIN E=RCLINE+1  D SET(" " ,RCLINE,1, 80)
  25865   "RTN","RCD PRPLM",149 ,0)
  25866    . S RCLIN E=RCLINE+1  D SET("FM S Cash Rec eipt Docum ent:",RCLI NE,1,80,0, IOUON,IOUO FF)
  25867   "RTN","RCD PRPLM",150 ,0)
  25868    . D SET($ P(FMSDOC," ^")_$S($P( FMSDOC,"^" ,3):"(on d eposit)",1 :""),RCLIN E,28,80)
  25869   "RTN","RCD PRPLM",151 ,0)
  25870    . D SET(" Status: "_ $P(FMSDOC, "^",2),RCL INE,55,80)
  25871   "RTN","RCD PRPLM",152 ,0)
  25872    . D DATA^ GECSSGET($ P(FMSDOC," ^"),1)
  25873   "RTN","RCD PRPLM",153 ,0)
  25874    . I '$G(G ECSDATA) Q
  25875   "RTN","RCD PRPLM",154 ,0)
  25876    . S GECSD A1=0 F  S  GECSDA1=$O (GECSDATA( 2100.1,GEC SDATA,10,G ECSDA1)) Q :'GECSDA1   D
  25877   "RTN","RCD PRPLM",155 ,0)
  25878    ..  S RCL INE=RCLINE +1 D SET(G ECSDATA(21 00.1,GECSD ATA,10,GEC SDA1),RCLI NE,1,80)
  25879   "RTN","RCD PRPLM",156 ,0)
  25880    ;
  25881   "RTN","RCD PRPLM",157 ,0)
  25882    ; Show EE OB detail  if switch  on
  25883   "RTN","RCD PRPLM",158 ,0)
  25884    D SHEOB^R CDPRPL2
  25885   "RTN","RCD PRPLM",159 ,0)
  25886    ;
  25887   "RTN","RCD PRPLM",160 ,0)
  25888    ; # of li nes in lis t
  25889   "RTN","RCD PRPLM",161 ,0)
  25890    S VALMCNT =RCLINE
  25891   "RTN","RCD PRPLM",162 ,0)
  25892    D HDR
  25893   "RTN","RCD PRPLM",163 ,0)
  25894    Q
  25895   "RTN","RCD PRPLM",164 ,0)
  25896    ;
  25897   "RTN","RCD PRPLM",165 ,0)
  25898   SET(STRING ,LINE,COLB EG,COLEND, FIELD,ON,O FF) ; Sets  a line in to the bod y
  25899   "RTN","RCD PRPLM",166 ,0)
  25900    ; of the  ListMan te mplate
  25901   "RTN","RCD PRPLM",167 ,0)
  25902    ; Input:
  25903   "RTN","RCD PRPLM",168 ,0)
  25904    ; STRING  - Label fo r the data  being set
  25905   "RTN","RCD PRPLM",169 ,0)
  25906    ; LINE -  line # bei ng built
  25907   "RTN","RCD PRPLM",170 ,0)
  25908    ; COLBEG  - Beginnin g column f or the tex t
  25909   "RTN","RCD PRPLM",171 ,0)
  25910    ; COLEND  - Ending c olumn for  the text
  25911   "RTN","RCD PRPLM",172 ,0)
  25912    ; FIELD -  Field # f or value b eing set,  optional
  25913   "RTN","RCD PRPLM",173 ,0)
  25914    ;    NOTE : if FIELD  is .17 tr ace # is r etrieved f rom EFT re cord
  25915   "RTN","RCD PRPLM",174 ,0)
  25916    ; ON, OFF  - for tex t characte ristics
  25917   "RTN","RCD PRPLM",175 ,0)
  25918    ; RCDPDAT A - array  for receip t being pr ocessed
  25919   "RTN","RCD PRPLM",176 ,0)
  25920    ; RCTRDA  - IEN in T RANSACTION  sub-file  (#344.01)
  25921   "RTN","RCD PRPLM",177 ,0)
  25922    N XX
  25923   "RTN","RCD PRPLM",178 ,0)
  25924    I $G(FIEL D) D
  25925   "RTN","RCD PRPLM",179 ,0)
  25926    . I FIELD =.17 S XX= $$TRCNUM(R CRECTDA) Q   ; trace  # from EFT  record, P RCA*4.5*33 2
  25927   "RTN","RCD PRPLM",180 ,0)
  25928    . ; all o ther field s
  25929   "RTN","RCD PRPLM",181 ,0)
  25930    . S XX=$G (RCDPDATA( 344.01,RCT RDA,FIELD, "E"))
  25931   "RTN","RCD PRPLM",182 ,0)
  25932    S:$G(FIEL D) STRING= STRING_$S( STRING="": "",1:": ") _XX
  25933   "RTN","RCD PRPLM",183 ,0)
  25934    I STRING= "",'$G(FIE LD) D SET^ VALM10(LIN E,$J("",80 )) Q
  25935   "RTN","RCD PRPLM",184 ,0)
  25936    I '$D(@VA LMAR@(LINE ,0)) D SET ^VALM10(LI NE,$J("",8 0))
  25937   "RTN","RCD PRPLM",185 ,0)
  25938    D SET^VAL M10(LINE,$ $SETSTR^VA LM1(STRING ,@VALMAR@( LINE,0),CO LBEG,COLEN D-COLBEG+1 ))
  25939   "RTN","RCD PRPLM",186 ,0)
  25940    I $G(ON)' =""!($G(OF F)'="") D  CNTRL^VALM 10(LINE,CO LBEG,$L(ST RING),ON,O FF)
  25941   "RTN","RCD PRPLM",187 ,0)
  25942    Q
  25943   "RTN","RCD PRPLM",188 ,0)
  25944    ;
  25945   "RTN","RCD PRPLM",189 ,0)
  25946   TRCNUM(ARB PIEN) ; re turns trac e #, ARBPI EN is IEN  in file #3 44 - PRCA* 4.5*332
  25947   "RTN","RCD PRPLM",190 ,0)
  25948    N DEPIEN, PTR
  25949   "RTN","RCD PRPLM",191 ,0)
  25950    ; If rece ipt manual ly created  then EFT  number is  in field . 17
  25951   "RTN","RCD PRPLM",192 ,0)
  25952    S PTR=+$P ($G(^RCY(3 44,ARBPIEN ,0)),U,17)   ;(#.17)  EFT RECORD  [17P:344. 31]
  25953   "RTN","RCD PRPLM",193 ,0)
  25954    ; Otherwi se auto-po sting crea ted the re ceipt, get  the EFT n umber
  25955   "RTN","RCD PRPLM",194 ,0)
  25956    D:'PTR
  25957   "RTN","RCD PRPLM",195 ,0)
  25958    . S DEPIE N=+$P($G(^ RCY(344,AR BPIEN,0)), U,6)  ; (# .06) DEPOS IT TICKET  [6P:344.1]
  25959   "RTN","RCD PRPLM",196 ,0)
  25960    . S PTR=+ $O(^RCY(34 4.3,"ARDEP ",DEPIEN,0 ))  ; use  deposit IE N to get I EN in fil  #344.3
  25961   "RTN","RCD PRPLM",197 ,0)
  25962    . S PTR=+ $O(^RCY(34 4.31,"B",P TR,0))  ;  Get the EF T Number
  25963   "RTN","RCD PRPLM",198 ,0)
  25964    ;
  25965   "RTN","RCD PRPLM",199 ,0)
  25966    Q $$GET1^ DIQ(344.31 ,PTR_",",. 04,"E")  ; (#.04) TRA CE # [4F]
  25967   "RTN","RCD PRPLM",200 ,0)
  25968    ;
  25969   "RTN","RCD PRPLM",201 ,0)
  25970   DIQ344(DA, DR) ; Retr ieves data  for field s in file  #344
  25971   "RTN","RCD PRPLM",202 ,0)
  25972    ; Input:    DA           - IEN  of the rec eipt to re trieve dat a from (#3 44)
  25973   "RTN","RCD PRPLM",203 ,0)
  25974    ;           DR           - List  of fields  to retrie ve data fo r
  25975   "RTN","RCD PRPLM",204 ,0)
  25976    ; Output:   RCDPDATA     - Arra y of retri eved data
  25977   "RTN","RCD PRPLM",205 ,0)
  25978    N %I,D0,D IC,DIQ,YY
  25979   "RTN","RCD PRPLM",206 ,0)
  25980    K RCDPDAT A(344,DA)
  25981   "RTN","RCD PRPLM",207 ,0)
  25982    S DIQ(0)= "IE",DIC=" ^RCY(344," ,DIQ="RCDP DATA"
  25983   "RTN","RCD PRPLM",208 ,0)
  25984    D EN^DIQ1
  25985   "RTN","RCD PRPLM",209 ,0)
  25986    Q
  25987   "RTN","RCD PRPLM",210 ,0)
  25988    ;
  25989   "RTN","RCD PRPLM",211 ,0)
  25990   DIQ34401(D A,SUBDA) ;  Retrieves  data for  fields in  the transa ction subf ile (#344. 01)
  25991   "RTN","RCD PRPLM",212 ,0)
  25992    ; of the  receipt fi le (#344)
  25993   "RTN","RCD PRPLM",213 ,0)
  25994    ; Input:    DA           - IEN  of the rec eipt to re trieve dat a from (#3 44)
  25995   "RTN","RCD PRPLM",214 ,0)
  25996    ;           SUBDA        - IEN  of the sub -file reco rd (#344.0 1)
  25997   "RTN","RCD PRPLM",215 ,0)
  25998    ; Output:   RCDPDATA     - Arra y of retri eved data
  25999   "RTN","RCD PRPLM",216 ,0)
  26000    N %I,D0,D IC,DIQ,DR
  26001   "RTN","RCD PRPLM",217 ,0)
  26002    K RCDPDAT A(344.01,S UBDA)
  26003   "RTN","RCD PRPLM",218 ,0)
  26004    S DR=1,DR (344.01)=" .01:1.02", DA(344.01) =SUBDA
  26005   "RTN","RCD PRPLM",219 ,0)
  26006    S DIQ(0)= "IE",DIC=" ^RCY(344," ,DIQ="RCDP DATA"
  26007   "RTN","RCD PRPLM",220 ,0)
  26008    D EN^DIQ1
  26009   "RTN","RCD PRPLM",221 ,0)
  26010    Q
  26011   "RTN","RCD PRPLM",222 ,0)
  26012    ;
  26013   "RTN","RCD PRPLM",223 ,0)
  26014   HDR ;EP fr om ListMan  Template  RCDP RECEI PT PROFILE
  26015   "RTN","RCD PRPLM",224 ,0)
  26016    ; Header  code for l ist manage r display
  26017   "RTN","RCD PRPLM",225 ,0)
  26018    N DATE,DE PIEN,EFTIE N,ERAIEN,F MSDOC,FMST TR,PAYER,R CDPDATA,RC EFT,XX,Z
  26019   "RTN","RCD PRPLM",226 ,0)
  26020    D DIQ344( RCRECTDA," .01;.04;.0 6;.08;.14; .17;.18;")
  26021   "RTN","RCD PRPLM",227 ,0)
  26022    ;
  26023   "RTN","RCD PRPLM",228 ,0)
  26024    ; PRCA*4. 5*321 - St art of mod ified code  block
  26025   "RTN","RCD PRPLM",229 ,0)
  26026    S XX=$E("    Receipt  #: "_RCDP DATA(344,R CRECTDA,.0 1,"E")_$$S P,1,39)
  26027   "RTN","RCD PRPLM",230 ,0)
  26028    S XX=XX_" Type of Pa yment: "_R CDPDATA(34 4,RCRECTDA ,.04,"E")
  26029   "RTN","RCD PRPLM",231 ,0)
  26030    S VALMHDR (1)=XX
  26031   "RTN","RCD PRPLM",232 ,0)
  26032    ;
  26033   "RTN","RCD PRPLM",233 ,0)
  26034    S Z=RCDPD ATA(344,RC RECTDA,.06 ,"E")
  26035   "RTN","RCD PRPLM",234 ,0)
  26036    S DEPIEN= +$P($G(^RC Y(344,RCRE CTDA,0)),U ,6)
  26037   "RTN","RCD PRPLM",235 ,0)
  26038    S RCEFT=+ $O(^RCY(34 4.3,"ARDEP ",DEPIEN,0 ))
  26039   "RTN","RCD PRPLM",236 ,0)
  26040    S EFTIEN= RCDPDATA(3 44,RCRECTD A,.17,"I")
  26041   "RTN","RCD PRPLM",237 ,0)
  26042    S FMSDOC= $$FMSSTAT^ RCDPUREC(R CRECTDA)
  26043   "RTN","RCD PRPLM",238 ,0)
  26044    S FMSTTR= $S($P(FMSD OC,"-",1)= "TR":1,1:0 )
  26045   "RTN","RCD PRPLM",239 ,0)
  26046    S XX="" D  
  26047   "RTN","RCD PRPLM",240 ,0)
  26048    . I 'RCEF T&'EFTIEN  S XX="   D eposit #:  "_Z Q
  26049   "RTN","RCD PRPLM",241 ,0)
  26050    . I RCEFT  S XX=" EF T Deposit:  "_Z Q
  26051   "RTN","RCD PRPLM",242 ,0)
  26052    . ; PRCA* 4.5*321 -  Since EFT  and ERA ar e now disp layed on t heir own l ine, put T IN/Payer h ere 
  26053   "RTN","RCD PRPLM",243 ,0)
  26054    . N TIN
  26055   "RTN","RCD PRPLM",244 ,0)
  26056    . S PAYER =$$GET1^DI Q(344.31,E FTIEN_",", .02,"E")
  26057   "RTN","RCD PRPLM",245 ,0)
  26058    . S TIN=$ $GET1^DIQ( 344.31,EFT IEN_",",.0 3,"E")
  26059   "RTN","RCD PRPLM",246 ,0)
  26060    . S XX="    Payer: " _TIN_"/"_P AYER
  26061   "RTN","RCD PRPLM",247 ,0)
  26062    S XX=$E(X X_$$SP,1,3 9)_" Recei pt Status:  "_RCDPDAT A(344,RCRE CTDA,.14," E")
  26063   "RTN","RCD PRPLM",248 ,0)
  26064    S VALMHDR (2)=XX
  26065   "RTN","RCD PRPLM",249 ,0)
  26066    ;
  26067   "RTN","RCD PRPLM",250 ,0)
  26068    S ERAIEN= RCDPDATA(3 44,RCRECTD A,.18,"I")
  26069   "RTN","RCD PRPLM",251 ,0)
  26070    S XX=""
  26071   "RTN","RCD PRPLM",252 ,0)
  26072    I FMSTTR! ERAIEN S X X="   ERA  #: "_RCDPD ATA(344,RC RECTDA,.18 ,"E")
  26073   "RTN","RCD PRPLM",253 ,0)
  26074    S XX=$E(X X_$$SP,1,2 1)
  26075   "RTN","RCD PRPLM",254 ,0)
  26076    I FMSTTR! ERAIEN S X X=XX_"ERA  TTL: "_$J( $$GET1^DIQ (344.4,ERA IEN_",",.0 5,"E"),9)
  26077   "RTN","RCD PRPLM",255 ,0)
  26078    S XX=$E(X X_$$SP,1,3 9)
  26079   "RTN","RCD PRPLM",256 ,0)
  26080    ;
  26081   "RTN","RCD PRPLM",257 ,0)
  26082    ; FMS doc ument and  status
  26083   "RTN","RCD PRPLM",258 ,0)
  26084    S XX=XX_"  FMS Docum ent: "_$TR ($P(FMSDOC ,"^")," ") _$S($P(FMS DOC,"^",3) :"(on depo sit)",1:"" )
  26085   "RTN","RCD PRPLM",259 ,0)
  26086    S VALMHDR (3)=XX
  26087   "RTN","RCD PRPLM",260 ,0)
  26088    ;
  26089   "RTN","RCD PRPLM",261 ,0)
  26090    S XX=""
  26091   "RTN","RCD PRPLM",262 ,0)
  26092    I FMSTTR! EFTIEN D
  26093   "RTN","RCD PRPLM",263 ,0)
  26094    . S XX="    EFT #: " _$$GET1^DI Q(344.31,E FTIEN_",", .01,"I")_" ."
  26095   "RTN","RCD PRPLM",264 ,0)
  26096    . S XX=XX _$$GET1^DI Q(344.31,E FTIEN_",", .14) ; PRC A*4.5*326
  26097   "RTN","RCD PRPLM",265 ,0)
  26098    S XX=$E(X X_$$SP,1,2 1)
  26099   "RTN","RCD PRPLM",266 ,0)
  26100    I FMSTTR! EFTIEN S X X=XX_"EFT  TTL: "_$J( $$GET1^DIQ (344.31,EF TIEN_",",. 07,"E"),9) _" "
  26101   "RTN","RCD PRPLM",267 ,0)
  26102    S XX=$E(X X_$$SP,1,3 9)
  26103   "RTN","RCD PRPLM",268 ,0)
  26104    S XX=XX_"  FMS Doc S tatus: "_$ P(FMSDOC," ^",2)
  26105   "RTN","RCD PRPLM",269 ,0)
  26106    S VALMHDR (4)=XX
  26107   "RTN","RCD PRPLM",270 ,0)
  26108    ; PRCA*4. 5*321 - En d of modif ied code b lock
  26109   "RTN","RCD PRPLM",271 ,0)
  26110    ;
  26111   "RTN","RCD PRPLM",272 ,0)
  26112    I RCDPDAT A(344,RCRE CTDA,.08," I") D
  26113   "RTN","RCD PRPLM",273 ,0)
  26114    . S VALMS G="Receipt  processed  on "_RCDP DATA(344,R CRECTDA,.0 8,"E")
  26115   "RTN","RCD PRPLM",274 ,0)
  26116    Q
  26117   "RTN","RCD PRPLM",275 ,0)
  26118    ;
  26119   "RTN","RCD PRPLM",276 ,0)
  26120   EXIT ;EP f rom ListMa n Template  RCDP RECE IPT PROFIL E
  26121   "RTN","RCD PRPLM",277 ,0)
  26122    ; Exit op tion/clean  up
  26123   "RTN","RCD PRPLM",278 ,0)
  26124    K ^TMP("R CDPRPLM",$ J)
  26125   "RTN","RCD PRPLM",279 ,0)
  26126    Q
  26127   "RTN","RCD PRPLM",280 ,0)
  26128    ;
  26129   "RTN","RCD PRPLM",281 ,0)
  26130   SP() Q $J( "",132)  ;  extrinsic  variable,  132 space s
  26131   "RTN","RCD PRPLM",282 ,0)
  26132    ;
  26133   "RTN","RCD PRSEA")
  26134   0^15^B8572 5248
  26135   "RTN","RCD PRSEA",1,0 )
  26136   RCDPRSEA ; WISC/RFJ,P JH,hrub -  extended s earch ;31  Oct 2018 1 8:43:20
  26137   "RTN","RCD PRSEA",2,0 )
  26138    ;;4.5;Acc ounts Rece ivable;**1 14,148,208 ,269,304,3 32**;Mar 2 0, 1995;Bu ild 34
  26139   "RTN","RCD PRSEA",3,0 )
  26140    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  26141   "RTN","RCD PRSEA",4,0 )
  26142    ;
  26143   "RTN","RCD PRSEA",5,0 )
  26144    ; enter a t top for  [RCDP EXTE NDED CHECK /CC SEARCH ] option
  26145   "RTN","RCD PRSEA",6,0 )
  26146    N DATEEND ,DATESTRT, RCDUP,RCPA YTYP,RCRPR T,RCRTRN,R CSRCH,RCTR GT,X,Y
  26147   "RTN","RCD PRSEA",7,0 )
  26148    ;
  26149   "RTN","RCD PRSEA",8,0 )
  26150    ; search  check, cre dit card,  trace #, o r All
  26151   "RTN","RCD PRSEA",9,0 )
  26152    W !!,"Ext ended AR B ATCH PAYME NT file se arch.",!
  26153   "RTN","RCD PRSEA",10, 0)
  26154    S RCSRCH= $$ASKSEA I  RCSRCH<1  Q
  26155   "RTN","RCD PRSEA",11, 0)
  26156    ;
  26157   "RTN","RCD PRSEA",12, 0)
  26158    S RCTRGT( "Any#")=U  F X=1,2,3  S RCTRGT($ $SBSCRPT(X ))=U  ; in itialize a ll search  targets
  26159   "RTN","RCD PRSEA",13, 0)
  26160    ; check #  to search  for
  26161   "RTN","RCD PRSEA",14, 0)
  26162    I RCSRCH= 1 S RCTRGT ("Check#") =$$ASKCHEK ^RCDPLPL1  I RCTRGT(" Check#")=- 1 Q
  26163   "RTN","RCD PRSEA",15, 0)
  26164    ; credit  card to se arch for
  26165   "RTN","RCD PRSEA",16, 0)
  26166    I RCSRCH= 2 S RCTRGT ("CredCard ")=$$ASKCR ED^RCDPLPL 1 I RCTRGT ("CredCard ")=-1 Q
  26167   "RTN","RCD PRSEA",17, 0)
  26168    ; trace #  to search  for
  26169   "RTN","RCD PRSEA",18, 0)
  26170    I RCSRCH= 3 S RCTRGT ("Trace#") =$$ASKTRAC E^RCDPLPL1  I RCTRGT( "Trace#")= -1 Q
  26171   "RTN","RCD PRSEA",19, 0)
  26172    I RCSRCH= 4 D  I RCT RGT("Any#" )=U Q
  26173   "RTN","RCD PRSEA",20, 0)
  26174    . S RCTRG T("Any#")= $$ASK4ALL  Q:RCTRGT(" Any#")=U
  26175   "RTN","RCD PRSEA",21, 0)
  26176    . S (RCTR GT("Check# "),RCTRGT( "CredCard" ),RCTRGT(" Trace#"))= RCTRGT("An y#")  ; fo r all 3 ty pes of sea rch
  26177   "RTN","RCD PRSEA",22, 0)
  26178    ; ask con tains or e quals
  26179   "RTN","RCD PRSEA",23, 0)
  26180    S RCSRCH( "type")=$$ ASKTYPE^RC DPLPL1 I R CSRCH("typ e")=-1 Q
  26181   "RTN","RCD PRSEA",24, 0)
  26182    S RCSRCH( "type")=$E (RCSRCH("t ype"))  ;  will be "E " or "C"
  26183   "RTN","RCD PRSEA",25, 0)
  26184    S RCDUP=0
  26185   "RTN","RCD PRSEA",26, 0)
  26186    I (RCSRCH =3!(RCSRCH =4))&($L($ G(RCTRGT(" Trace#"))) >44) D  I  RCDUP=-1 Q
  26187   "RTN","RCD PRSEA",27, 0)
  26188    . S RCDUP =$$ASKDUP( )
  26189   "RTN","RCD PRSEA",28, 0)
  26190    ;
  26191   "RTN","RCD PRSEA",29, 0)
  26192    ; ask rec eipt open  dates
  26193   "RTN","RCD PRSEA",30, 0)
  26194    W ! D DAT ESEL^RCRJR TRA("RECEI PT Opened" )
  26195   "RTN","RCD PRSEA",31, 0)
  26196    I '$G(DAT ESTRT)!('$ G(DATEEND) ) Q
  26197   "RTN","RCD PRSEA",32, 0)
  26198    ;
  26199   "RTN","RCD PRSEA",33, 0)
  26200    F X=1,2,3  S RCTRGT( $$SBSCRPT( X))=$$UP(R CTRGT($$SB SCRPT(X)))  ; case-in sensitive  search
  26201   "RTN","RCD PRSEA",34, 0)
  26202    S RCSRCH( "FromDt")= DATESTRT\1 ,RCSRCH("T oDt")=DATE END\1  ; s tart/end d ates witho ut time
  26203   "RTN","RCD PRSEA",35, 0)
  26204    S RCRPRT( "HdrFrom") =$$FMTE^XL FDT(RCSRCH ("FromDt") ),RCRPRT(" HdrTo")=$$ FMTE^XLFDT (RCSRCH("T oDt"))
  26205   "RTN","RCD PRSEA",36, 0)
  26206    ; select  device
  26207   "RTN","RCD PRSEA",37, 0)
  26208    W ! N %ZI S S %ZIS=" Q" D ^%ZIS  I POP Q
  26209   "RTN","RCD PRSEA",38, 0)
  26210    I $D(IO(" Q")) D  Q
  26211   "RTN","RCD PRSEA",39, 0)
  26212    . N ZTDES C,ZTQUEUED ,ZTRTN,ZTS AVE,ZTSK
  26213   "RTN","RCD PRSEA",40, 0)
  26214    . S ZTDES C="Extende d Check/Tr ace#/Credi t Card Sea rch"
  26215   "RTN","RCD PRSEA",41, 0)
  26216    . S ZTSAV E("RC*")=" ",ZTSAVE(" ZTREQ")="@ ",ZTRTN="D Q^"_$T(+0)
  26217   "RTN","RCD PRSEA",42, 0)
  26218    . D ^%ZTL OAD
  26219   "RTN","RCD PRSEA",43, 0)
  26220    . W !!,$S ($G(ZTSK): "Report qu eued as ta sk #"_ZTSK ,1:"Unable  to queue  this repor t.")
  26221   "RTN","RCD PRSEA",44, 0)
  26222    . K IO("Q ")
  26223   "RTN","RCD PRSEA",45, 0)
  26224    ; from he re on for  interactiv e user onl y
  26225   "RTN","RCD PRSEA",46, 0)
  26226    F  D  Q:R CSRCH("Exi t")  ; loo p here if  no results  found
  26227   "RTN","RCD PRSEA",47, 0)
  26228    . D DQ I  RCSRCH("Cn tr")!RCSRC H("Exit")  S RCSRCH(" Exit")=1 Q   ; result s returned  or exit i ndicated
  26229   "RTN","RCD PRSEA",48, 0)
  26230    . I RCSRC H=4 S RCSR CH("Exit") =1 Q  ; 'A ll' was se lected, do n't ask, e xit
  26231   "RTN","RCD PRSEA",49, 0)
  26232    . S RCSRC H("PrevTyp e")=RCSRCH   ; save f or user in teraction
  26233   "RTN","RCD PRSEA",50, 0)
  26234    . S RCSRC H("Exit")= '$$ASK2CON T Q:RCSRCH ("Exit")
  26235   "RTN","RCD PRSEA",51, 0)
  26236    . F  D  Q :'$L(RCSRC H("PrevTyp e"))!RCSRC H("Exit")
  26237   "RTN","RCD PRSEA",52, 0)
  26238    ..  S RCS RCH("NewTy pe")=$$ASK SEA I RCSR CH("NewTyp e")<1 S RC SRCH("Exit ")=1 Q
  26239   "RTN","RCD PRSEA",53, 0)
  26240    ..  I RCS RCH("NewTy pe")=RCSRC H("PrevTyp e") D  Q
  26241   "RTN","RCD PRSEA",54, 0)
  26242    ...   N D IR,DTOUT,D UOUT,X,Y
  26243   "RTN","RCD PRSEA",55, 0)
  26244    ...   S D IR(0)="EA" ,DIR("A")= "Press ENT ER to cont inue, '^'  to exit: "
  26245   "RTN","RCD PRSEA",56, 0)
  26246    ...   S D IR("A",1)= " ",DIR("A ",2)="That  was the p revious se arch type. "
  26247   "RTN","RCD PRSEA",57, 0)
  26248    ...   S D IR("A",3)= "Please se lect anoth er type of  search."  D ^DIR
  26249   "RTN","RCD PRSEA",58, 0)
  26250    ...   S R CSRCH("Exi t")=$S(X[U !$D(DUOUT) !$D(DTOUT) :1,1:0)
  26251   "RTN","RCD PRSEA",59, 0)
  26252    ..  Q:RCS RCH("Exit" )
  26253   "RTN","RCD PRSEA",60, 0)
  26254    ..  F X=1 ,2,3 S RCT RGT($$SBSC RPT(X))=U   ; re-init ialize all  search ta rgets
  26255   "RTN","RCD PRSEA",61, 0)
  26256    ..  S RCS RCH=RCSRCH ("NewType" ),RCSRCH(" PrevType") =""  ; set  previous  type to nu ll to exit  loop
  26257   "RTN","RCD PRSEA",62, 0)
  26258    ..  S RCT RGT($$SBSC RPT(RCSRCH ))=RCSRCH( "PrevTrgt" )
  26259   "RTN","RCD PRSEA",63, 0)
  26260    ..  I RCS RCH=4 F X= 1,2,3 S RC TRGT($$SBS CRPT(X))=R CSRCH("Pre vTrgt")  ;  if new se arch is AL L
  26261   "RTN","RCD PRSEA",64, 0)
  26262    ;
  26263   "RTN","RCD PRSEA",65, 0)
  26264    Q
  26265   "RTN","RCD PRSEA",66, 0)
  26266    ;
  26267   "RTN","RCD PRSEA",67, 0)
  26268   DQ ; entry  from Task Man or fro m above
  26269   "RTN","RCD PRSEA",68, 0)
  26270    N A,B,J,R CACCNT,RCB TCH,RCPAYT YP,RCTRANS ,RCTRCNUM, RCXREFDT,X ,Y
  26271   "RTN","RCD PRSEA",69, 0)
  26272    ; print r eport
  26273   "RTN","RCD PRSEA",70, 0)
  26274    S RCRPRT( "HdrTime") =$$FMTE^XL FDT($$NOW^ XLFDT)  ;  NOW in ext ernal form at
  26275   "RTN","RCD PRSEA",71, 0)
  26276    S RCRPRT( "HdrPage#" )=1,RCSRCH ("Exit")=0 ,RCSRCH("C ntr")=0  ;  page numb er, exit f lag, found  count
  26277   "RTN","RCD PRSEA",72, 0)
  26278    ; save ta rget for a dditional  searches
  26279   "RTN","RCD PRSEA",73, 0)
  26280    S RCSRCH( "PrevTrgt" )=RCTRGT($ $SBSCRPT(R CSRCH))
  26281   "RTN","RCD PRSEA",74, 0)
  26282    U IO D H
  26283   "RTN","RCD PRSEA",75, 0)
  26284    S RCXREFD T=RCSRCH(" ToDt")+.5   ; initial ize to las t date plu s a fracti on, "AO" i ndex has t ime
  26285   "RTN","RCD PRSEA",76, 0)
  26286    F  S RCXR EFDT=$O(^R CY(344,"AO ",RCXREFDT ),-1) Q:'R CXREFDT!(R CXREFDT<RC SRCH("From Dt"))  D C HKTRANS(RC XREFDT)
  26287   "RTN","RCD PRSEA",77, 0)
  26288    ;
  26289   "RTN","RCD PRSEA",78, 0)
  26290    W:'$G(RCS RCH("Exit" )) !!,"Tot al records  found: "_ $FN(RCSRCH ("Cntr")," ,")
  26291   "RTN","RCD PRSEA",79, 0)
  26292    I '($E(IO ST,1,2)="C -")!$G(ZTS K) S RCSRC H("Exit")= 1  ; conti nue only i f interact ive user
  26293   "RTN","RCD PRSEA",80, 0)
  26294    U IO(0) D  ^%ZISC
  26295   "RTN","RCD PRSEA",81, 0)
  26296    Q:RCSRCH( "Exit")
  26297   "RTN","RCD PRSEA",82, 0)
  26298    D  ; ask  user to pr ess ENTER  if no '^'
  26299   "RTN","RCD PRSEA",83, 0)
  26300    . N DIR S  DIR(0)="E A",DIR("A" )="Search  Finished.  Press ENTE R to conti nue: ",DIR ("A",1)="  " D ^DIR
  26301   "RTN","RCD PRSEA",84, 0)
  26302    Q
  26303   "RTN","RCD PRSEA",85, 0)
  26304    ;
  26305   "RTN","RCD PRSEA",86, 0)
  26306   CHKTRANS(R CXREFDT) ;  check TRA NSACTION m ultiple on  date RCXR EFDT
  26307   "RTN","RCD PRSEA",87, 0)
  26308    S RCBTCH= 0  ; IEN i n AR BATCH  PAYMENT f ile (#344)
  26309   "RTN","RCD PRSEA",88, 0)
  26310    F  S RCBT CH=$O(^RCY (344,"AO", RCXREFDT,R CBTCH)) Q: 'RCBTCH!($ G(RCSRCH(" Exit")))   D
  26311   "RTN","RCD PRSEA",89, 0)
  26312    . S RCBTC H(0)=$G(^R CY(344,RCB TCH,0))
  26313   "RTN","RCD PRSEA",90, 0)
  26314    . S RCTRA NS=0  ; ^R CY(344,D0, 1,0)=^344. 01AI^^  (# 1) TRANSAC TION
  26315   "RTN","RCD PRSEA",91, 0)
  26316    . F  S RC TRANS=$O(^ RCY(344,RC BTCH,1,RCT RANS)) Q:' RCTRANS!($ G(RCSRCH(" Exit")))   D
  26317   "RTN","RCD PRSEA",92, 0)
  26318    ..  I $E( IOST,1,2)= "C-" R X:0  I X[U S R CSRCH("Exi t")=1 Q  ;  exit if u ser types  '^' during  search
  26319   "RTN","RCD PRSEA",93, 0)
  26320    ..  S RCT RANS(0)=$G (^RCY(344, RCBTCH,1,R CTRANS,0))
  26321   "RTN","RCD PRSEA",94, 0)
  26322    ..  ;  ch eck # sear ch
  26323   "RTN","RCD PRSEA",95, 0)
  26324    ..  I RCS RCH=1!(RCS RCH=4) D   Q:RCSRCH<4
  26325   "RTN","RCD PRSEA",96, 0)
  26326    ...   S X =$P(RCTRAN S(0),U,7)  Q:X=""
  26327   "RTN","RCD PRSEA",97, 0)
  26328    ...   I R CSRCH("typ e")="E" Q: $$UP(X)'=R CTRGT("Che ck#")  ;eq uals
  26329   "RTN","RCD PRSEA",98, 0)
  26330    ...   I $ $UP(X)'[RC TRGT("Chec k#") Q                       ;co ntains
  26331   "RTN","RCD PRSEA",99, 0)
  26332    ...   D D ISPLAY(1,X ) S RCSRCH ("Cntr")=R CSRCH("Cnt r")+1
  26333   "RTN","RCD PRSEA",100 ,0)
  26334    ..  ;  tr ace # sear ch
  26335   "RTN","RCD PRSEA",101 ,0)
  26336    ..  I RCS RCH=3!(RCS RCH=4) D   Q:RCSRCH<4
  26337   "RTN","RCD PRSEA",102 ,0)
  26338    ...   S R CTRCNUM=$$ UP($$TRACE (RCBTCH(0) )) Q:RCTRC NUM=""
  26339   "RTN","RCD PRSEA",103 ,0)
  26340    ...   I ' $$CHKTRACE (RCSRCH("t ype"),RCTR CNUM,RCTRG T("Trace#" ),RCDUP) Q
  26341   "RTN","RCD PRSEA",104 ,0)
  26342    ...   D D ISPLAY(3,R CTRCNUM) S  RCSRCH("C ntr")=RCSR CH("Cntr") +1
  26343   "RTN","RCD PRSEA",105 ,0)
  26344    ..  ; fal l through  to credit  card # sea rch
  26345   "RTN","RCD PRSEA",106 ,0)
  26346    ..  Q:'(( RCSRCH=2)! (RCSRCH=4) )
  26347   "RTN","RCD PRSEA",107 ,0)
  26348    ..  S X=$ P(RCTRANS( 0),U,11) Q :X=""
  26349   "RTN","RCD PRSEA",108 ,0)
  26350    ..  I RCS RCH("type" )="E" Q:X' =RCTRGT("C redCard")   ;equals
  26351   "RTN","RCD PRSEA",109 ,0)
  26352    ..  I X'[ RCTRGT("Cr edCard") Q                        ;contains
  26353   "RTN","RCD PRSEA",110 ,0)
  26354    ..  D DIS PLAY(2,X)  S RCSRCH(" Cntr")=RCS RCH("Cntr" )+1
  26355   "RTN","RCD PRSEA",111 ,0)
  26356    ;
  26357   "RTN","RCD PRSEA",112 ,0)
  26358    Q
  26359   "RTN","RCD PRSEA",113 ,0)
  26360    ;
  26361   "RTN","RCD PRSEA",114 ,0)
  26362   DISPLAY(RC PAYTYP,RCI TMFND) ;   display th e payment
  26363   "RTN","RCD PRSEA",115 ,0)
  26364    ; RCPAYTY P - 1:chec k #, 2: cr edit card,  3:trace #
  26365   "RTN","RCD PRSEA",116 ,0)
  26366    ; RCITMFN D - value  found
  26367   "RTN","RCD PRSEA",117 ,0)
  26368    Q:$G(RCSR CH("Exit") )  ; exit  flag
  26369   "RTN","RCD PRSEA",118 ,0)
  26370    ; handle  display to  screen
  26371   "RTN","RCD PRSEA",119 ,0)
  26372    I $E(IOST ,1,2)="C-" ,$Y>(IOSL- 6) D  Q:RC SRCH("Exit ")
  26373   "RTN","RCD PRSEA",120 ,0)
  26374    . S RCSRC H("Exit")= 0
  26375   "RTN","RCD PRSEA",121 ,0)
  26376    . N DIR,X ,Y
  26377   "RTN","RCD PRSEA",122 ,0)
  26378    . S DIR(0 )="EA",DIR ("A")="Pre ss ENTER t o continue , '^' to e xit: " D ^ DIR
  26379   "RTN","RCD PRSEA",123 ,0)
  26380    . S RCSRC H("Exit")= $S(X[U!$D( DUOUT)!$D( DTOUT):1,1 :0)
  26381   "RTN","RCD PRSEA",124 ,0)
  26382    . Q:RCSRC H("Exit")   ; user in dicated to  stop
  26383   "RTN","RCD PRSEA",125 ,0)
  26384    . D H
  26385   "RTN","RCD PRSEA",126 ,0)
  26386    ; next li ne for non -interacti ve device
  26387   "RTN","RCD PRSEA",127 ,0)
  26388    I '($E(IO ST,1,2)="C -"),$Y>(IO SL-2) D H
  26389   "RTN","RCD PRSEA",128 ,0)
  26390    ; receipt
  26391   "RTN","RCD PRSEA",129 ,0)
  26392    S J=$P(RC BTCH(0),U) ,A=$P(RCBT CH(0),U,3)   ; A is t he date op ened
  26393   "RTN","RCD PRSEA",130 ,0)
  26394    S J=J_$J( " ",15-$L( J))_$E(A,4 ,5)_"/"_$E (A,6,7)_"/ "_$E(A,2,3 )  ; forma t date ope ned
  26395   "RTN","RCD PRSEA",131 ,0)
  26396    S J=J_$J( " ",27-$L( J))_RCTRAN S  ; add t ransaction  number
  26397   "RTN","RCD PRSEA",132 ,0)
  26398    ; account
  26399   "RTN","RCD PRSEA",133 ,0)
  26400    S RCACCNT ("Pntr")=$ P(RCTRANS( 0),U,3),RC ACCNT=" -"
  26401   "RTN","RCD PRSEA",134 ,0)
  26402    I RCACCNT ("Pntr")[" PRCA(430,"  S RCACCNT =$P($G(^PR CA(430,+RC ACCNT("Pnt r"),0)),U)
  26403   "RTN","RCD PRSEA",135 ,0)
  26404    I RCACCNT ("Pntr")[" DPT(" S RC ACCNT=$P($ G(^DPT(+RC ACCNT("Pnt r"),0)),U)
  26405   "RTN","RCD PRSEA",136 ,0)
  26406    S J=J_$J( " ",31-$L( J))_RCACCN T  ; add a ccount
  26407   "RTN","RCD PRSEA",137 ,0)
  26408    S J=J_$J( " ",55-$L( J))_"$"_$J ($P(RCTRAN S(0),U,4), 8,2)  ; ad d amount
  26409   "RTN","RCD PRSEA",138 ,0)
  26410    W !,J
  26411   "RTN","RCD PRSEA",139 ,0)
  26412    ;  check/ trace/cred it card nu mber
  26413   "RTN","RCD PRSEA",140 ,0)
  26414    S J=RCITM FND
  26415   "RTN","RCD PRSEA",141 ,0)
  26416    ; if sear ch all typ es, indica te what wa s found
  26417   "RTN","RCD PRSEA",142 ,0)
  26418    I RCSRCH= 4 S J=J_"    ("_$S(RC PAYTYP=1:" Check #",R CPAYTYP=2: "Credit Ca rd",1:"Tra ce #")_")"
  26419   "RTN","RCD PRSEA",143 ,0)
  26420    W !,"   " _J
  26421   "RTN","RCD PRSEA",144 ,0)
  26422    Q
  26423   "RTN","RCD PRSEA",145 ,0)
  26424    ;
  26425   "RTN","RCD PRSEA",146 ,0)
  26426   H ;  heade r
  26427   "RTN","RCD PRSEA",147 ,0)
  26428    S A=RCRPR T("HdrTime ")_" Page:  "_RCRPRT( "HdrPage#" ),RCRPRT(" HdrPage#") =RCRPRT("H drPage#")+ 1
  26429   "RTN","RCD PRSEA",148 ,0)
  26430    S B="Exte nded Check  #/Trace # /Credit Ca rd Search" ,$E(B,80-$ L(A)+1,80) =A
  26431   "RTN","RCD PRSEA",149 ,0)
  26432    W @IOF,B
  26433   "RTN","RCD PRSEA",150 ,0)
  26434    W !,"  Fo r the Date  Range: "_ RCRPRT("Hd rFrom")_"   to  "_RCR PRT("HdrTo ")
  26435   "RTN","RCD PRSEA",151 ,0)
  26436    S B="        Searchi ng for: "_ $S(RCSRCH= 1:"CHECK " ,RCSRCH=2: "CREDIT CA RD ",RCSRC H=3:"TRACE  # ",1:"AL L TYPES")
  26437   "RTN","RCD PRSEA",152 ,0)
  26438    S B=B_$S( RCSRCH("ty pe")="E":"  EQUAL",1: " CONTAIN" )_$S(RCSRC H<4:"S",1: "ING")_" "  ; handle  plurals
  26439   "RTN","RCD PRSEA",153 ,0)
  26440    S B=B_$C( 34)_RCTRGT ($$SBSCRPT (RCSRCH))_ $C(34)
  26441   "RTN","RCD PRSEA",154 ,0)
  26442    W !,B
  26443   "RTN","RCD PRSEA",155 ,0)
  26444    W !,"Rece ipt        Open Date   Trans  Ac count                     Amount "
  26445   "RTN","RCD PRSEA",156 ,0)
  26446    W !,"   " _$S(RCSRCH =1:"Check  #",RCSRCH= 2:"Credit  Card #",RC SRCH=3:"Tr ace #",1:" Any #")
  26447   "RTN","RCD PRSEA",157 ,0)
  26448    W !,$TR($ J(" ",80), " ","=")   ; 80 equal  signs
  26449   "RTN","RCD PRSEA",158 ,0)
  26450    Q
  26451   "RTN","RCD PRSEA",159 ,0)
  26452    ;
  26453   "RTN","RCD PRSEA",160 ,0)
  26454   TRACE(RC34 4ZRO) ; Re turn trace  # for rec eipt, RC34 4ZRO - zer o node fro m file #34 4
  26455   "RTN","RCD PRSEA",161 ,0)
  26456    N P
  26457   "RTN","RCD PRSEA",162 ,0)
  26458    S P=+$P(R C344ZRO,U, 18) I P Q  $P($G(^RCY (344.4,P,0 )),U,2)  ;  (#.18) ER A REFERENC E [18P:344 .4] > 344. 4,(#.02) T RACE NUMBE R [2F]
  26459   "RTN","RCD PRSEA",163 ,0)
  26460    S P=+$P(R C344ZRO,U, 17) I P Q  $P($G(^RCY (344.31,P, 0)),U,4)   ; (#.17) E FT RECORD  [17P:344.3 1] > 344.3 1,(#.04) T RACE # [4F ]
  26461   "RTN","RCD PRSEA",164 ,0)
  26462    Q ""  ; n o trace #  found
  26463   "RTN","RCD PRSEA",165 ,0)
  26464    ;
  26465   "RTN","RCD PRSEA",166 ,0)
  26466   ASKSEA() ;   ask sear ch field
  26467   "RTN","RCD PRSEA",167 ,0)
  26468    N DIR,DIR UT,DTOUT,D UOUT,X,Y
  26469   "RTN","RCD PRSEA",168 ,0)
  26470    S DIR(0)= "SAO^1:Che ck;2:Credi t Card;3:T race #;4:A ll"
  26471   "RTN","RCD PRSEA",169 ,0)
  26472    S DIR("A" )="Search  for Check,  Credit Ca rd, Trace  #, or All:  "
  26473   "RTN","RCD PRSEA",170 ,0)
  26474    S DIR("B" )="All"
  26475   "RTN","RCD PRSEA",171 ,0)
  26476    D ^DIR
  26477   "RTN","RCD PRSEA",172 ,0)
  26478    I $G(DTOU T)!($G(DUO UT)) S Y=- 1
  26479   "RTN","RCD PRSEA",173 ,0)
  26480    Q Y
  26481   "RTN","RCD PRSEA",174 ,0)
  26482    ;
  26483   "RTN","RCD PRSEA",175 ,0)
  26484   ASK4ALL()  ; Ask the  ePayments  trace valu e for ALL  types, ret urns '^' o n null or  timeout
  26485   "RTN","RCD PRSEA",176 ,0)
  26486    N DIR,X,Y
  26487   "RTN","RCD PRSEA",177 ,0)
  26488    S DIR(0)= "FAO^3:50"
  26489   "RTN","RCD PRSEA",178 ,0)
  26490    S DIR("A" ,1)="Enter  the check , credit c ard, or tr ace number  to Search  for"
  26491   "RTN","RCD PRSEA",179 ,0)
  26492     S DIR("A ")="in All  types: "
  26493   "RTN","RCD PRSEA",180 ,0)
  26494    S DIR("?" )="Enter a  search nu mber, 3 to  50 charac ters free  text."
  26495   "RTN","RCD PRSEA",181 ,0)
  26496    D ^DIR
  26497   "RTN","RCD PRSEA",182 ,0)
  26498    I $G(DTOU T)!($G(DUO UT)) S Y=U
  26499   "RTN","RCD PRSEA",183 ,0)
  26500    Q $S(Y'=" ":$$UP(Y), 1:U)
  26501   "RTN","RCD PRSEA",184 ,0)
  26502    ;
  26503   "RTN","RCD PRSEA",185 ,0)
  26504   ASK2CONT()  ; Boolean  function,  ask user  if they wa nt to sear ch again
  26505   "RTN","RCD PRSEA",186 ,0)
  26506    ; returns  1 if user  wants a n ew search,  else zero
  26507   "RTN","RCD PRSEA",187 ,0)
  26508    N DIR,DTO UT,DUOUT,X ,Y
  26509   "RTN","RCD PRSEA",188 ,0)
  26510    S RCRTRN= 0,DIR(0)=" YA",DIR("A ")="Would  you like t o perform  another se arch? "
  26511   "RTN","RCD PRSEA",189 ,0)
  26512    S DIR("A" ,1)=" "
  26513   "RTN","RCD PRSEA",190 ,0)
  26514    S DIR("A" ,2)="You c an search  for "_$C(3 4)_RCTRGT( $$SBSCRPT( RCSRCH("Pr evType"))) _$C(34)_"  in another  kind of s earch."
  26515   "RTN","RCD PRSEA",191 ,0)
  26516    S DIR("A" ,3)=" "
  26517   "RTN","RCD PRSEA",192 ,0)
  26518    S DIR("?" )="Enter ' YES' to se arch again  using the  same ePay ments valu es.",DIR(" B")="NO"
  26519   "RTN","RCD PRSEA",193 ,0)
  26520    D ^DIR
  26521   "RTN","RCD PRSEA",194 ,0)
  26522    Q $S(X[U! $D(DUOUT)! $D(DTOUT)! 'Y:0,1:1)
  26523   "RTN","RCD PRSEA",195 ,0)
  26524    ;
  26525   "RTN","RCD PRSEA",196 ,0)
  26526   ASKDUP() ;  Boolean f unction, a sk user if  they wish  to includ e trace nu mbers endi ng in "-DU Pn"
  26527   "RTN","RCD PRSEA",197 ,0)
  26528    ; returns  1 if user  wants to  include du plicate tr ace#, else  zero
  26529   "RTN","RCD PRSEA",198 ,0)
  26530    N DIR,DTO UT,DUOUT,X ,Y
  26531   "RTN","RCD PRSEA",199 ,0)
  26532    S RCRTRN= 0,DIR(0)=" YA",DIR("A ")="Includ e Duplicat e Trace#s:  "
  26533   "RTN","RCD PRSEA",200 ,0)
  26534    S DIR("A" ,1)="If a  trace numb er is grea ter than 4 5 characte rs and a d uplicated  ERA is"
  26535   "RTN","RCD PRSEA",201 ,0)
  26536    S DIR("A" ,2)="recei ved, the t race numbe r may be s hortened,  so that -D UP can be  added"
  26537   "RTN","RCD PRSEA",202 ,0)
  26538    S DIR("A" ,3)="to th e end.  An swering ye s, will ca use these  trace numb ers to be  included"
  26539   "RTN","RCD PRSEA",203 ,0)
  26540    S DIR("A" ,4)="in th e search r esults."
  26541   "RTN","RCD PRSEA",204 ,0)
  26542    S DIR("A" ,5)=" "
  26543   "RTN","RCD PRSEA",205 ,0)
  26544    S DIR("?" )="Enter ' YES' to in clude dupl icate trac e numbers. ",DIR("B") ="NO" D ^D IR
  26545   "RTN","RCD PRSEA",206 ,0)
  26546    Q $S(X[U! $D(DUOUT)! $D(DTOUT): -1,1:+Y)
  26547   "RTN","RCD PRSEA",207 ,0)
  26548    ;
  26549   "RTN","RCD PRSEA",208 ,0)
  26550   CHKTRACE(T YPE,TRACE, TARGET,DUP ) ; Check  if Trace#  is a match
  26551   "RTN","RCD PRSEA",209 ,0)
  26552    ; Input:  TYPE - Typ e of searc h E=equals , C=CONTAI NS
  26553   "RTN","RCD PRSEA",210 ,0)
  26554    ;         TRACE - TR ACE# from  receipt
  26555   "RTN","RCD PRSEA",211 ,0)
  26556    ;         TARGET - S tring user  is search ing for
  26557   "RTN","RCD PRSEA",212 ,0)
  26558    ;         DUP - 1 -  include du plicates,  otherwise  0.
  26559   "RTN","RCD PRSEA",213 ,0)
  26560    ; Output:  1 - trace  number ma tches the  target, ot herwise 0.
  26561   "RTN","RCD PRSEA",214 ,0)
  26562    ;
  26563   "RTN","RCD PRSEA",215 ,0)
  26564    N FOUND,X
  26565   "RTN","RCD PRSEA",216 ,0)
  26566    I TYPE="E ",TRACE=TA RGET Q 1 ; equals
  26567   "RTN","RCD PRSEA",217 ,0)
  26568    I TYPE="C ",TRACE[TA RGET Q 1 ; contains
  26569   "RTN","RCD PRSEA",218 ,0)
  26570    I RCDUP S  FOUND=0 D   I FOUND  Q 1 ; Incl ude duplic ates
  26571   "RTN","RCD PRSEA",219 ,0)
  26572    . I TRACE '["-DUP" Q   ; not a  duplicate
  26573   "RTN","RCD PRSEA",220 ,0)
  26574    . S X=$P( TRACE,"-DU P",1)
  26575   "RTN","RCD PRSEA",221 ,0)
  26576    . I TYPE= "E",X=$E(T ARGET,1,$L (X)) S FOU ND=1
  26577   "RTN","RCD PRSEA",222 ,0)
  26578    . I TYPE= "C",X[$E(T ARGET,1,$L (X)) S FOU ND=1
  26579   "RTN","RCD PRSEA",223 ,0)
  26580    Q 0
  26581   "RTN","RCD PRSEA",224 ,0)
  26582    ;
  26583   "RTN","RCD PRSEA",225 ,0)
  26584    ; return  subscript  for search  type, if  type is 4  all search  targets a re the sam e
  26585   "RTN","RCD PRSEA",226 ,0)
  26586   SBSCRPT(X)  Q $S(X=1: "Check#",X =2:"CredCa rd",1:"Tra ce#")
  26587   "RTN","RCD PRSEA",227 ,0)
  26588    ; functio n, upperca se
  26589   "RTN","RCD PRSEA",228 ,0)
  26590   UP(T) Q $T R(T,"abcde fghijklmno pqrstuvwxy z","ABCDEF GHIJKLMNOP QRSTUVWXYZ ")
  26591   "RTN","RCP 332")
  26592   0^^B114848 97
  26593   "RTN","RCP 332",1,0)
  26594   RCP332 ;AI TC/CJE,hru bovcak - e Payment Lo ckbox Post -Installat ion Proces sing ;4 Oc t 2018 10: 29:18
  26595   "RTN","RCP 332",2,0)
  26596    ;;4.5;Acc ounts Rece ivable;**3 32**;Oct 4 , 2018;Bui ld 34
  26597   "RTN","RCP 332",3,0)
  26598    ;Per VA D irective 6 402, this  routine sh ould not b e modified .
  26599   "RTN","RCP 332",4,0)
  26600    Q
  26601   "RTN","RCP 332",5,0)
  26602    ;
  26603   "RTN","RCP 332",6,0)
  26604   POST ;
  26605   "RTN","RCP 332",7,0)
  26606    N RCMSG,X ,Y
  26607   "RTN","RCP 332",8,0)
  26608    D BMES^XP DUTL("PRCA *4.5*332 p ost-instal lation wor k "_$$HTE^ XLFDT($H))  ; add dat e/time to  log
  26609   "RTN","RCP 332",9,0)
  26610    ;
  26611   "RTN","RCP 332",10,0)
  26612    ;(#.13) T RICARE EFT  POST PREV ENT DAYS [ 13N] updat e is idemp otent if v alue is in -bounds
  26613   "RTN","RCP 332",11,0)
  26614    S RCMSG=" TRICARE EF T POST PRE VENT DAYS"  D  ; RCMS G holds ac tion perfo rmed
  26615   "RTN","RCP 332",12,0)
  26616    . S X(344 .61,0)=$G( ^RCY(344.6 1,1,0)),Y= $P(X(344.6 1,0),U,13) ,RCMSG("pr ev")=Y
  26617   "RTN","RCP 332",13,0)
  26618    . ; minim um is 14 d ays, maxim um is 60
  26619   "RTN","RCP 332",14,0)
  26620    . I (Y>13 )&(Y<61) S  RCMSG=RCM SG_" value  is "_Y_"  days. No a ction take n." K RCMS G("prev")  Q  ; minim um is 14 d ays, maxim um is 60
  26621   "RTN","RCP 332",15,0)
  26622    . L +^RCY (344.61,1) :DILOCKTM  E  D  Q  ;  exclusive  access
  26623   "RTN","RCP 332",16,0)
  26624    ..  S RCM SG="Error,  unable to  update "_ RCMSG_"  C annot LOCK  entry."
  26625   "RTN","RCP 332",17,0)
  26626    . ; set d efault to  30
  26627   "RTN","RCP 332",18,0)
  26628    . N RCFDA ,RCFMERR
  26629   "RTN","RCP 332",19,0)
  26630    . S RCFDA (344.61,"1 ,",.13)=30   ; only 1  entry in  344.61
  26631   "RTN","RCP 332",20,0)
  26632    . D FILE^ DIE("","RC FDA","RCFM ERR")
  26633   "RTN","RCP 332",21,0)
  26634    . I $D(RC FMERR) D   Q  ; handl e FileMan  error
  26635   "RTN","RCP 332",22,0)
  26636    ..  S RCM SG=RCMSG_"  not updat ed due to  error."
  26637   "RTN","RCP 332",23,0)
  26638    ..  S X=" RCFMERR" F   S X=$Q(@ X) Q:X=""   S Y=@X D  BMES^XPDUT L(Y)  ; pu t error te xt into lo g
  26639   "RTN","RCP 332",24,0)
  26640    . S X(344 .61,0)=$G( ^RCY(344.6 1,1,0)),Y= +$P(X(344. 61,0),U,13 )
  26641   "RTN","RCP 332",25,0)
  26642    . L -^RCY (344.61,1)  S RCMSG=R CMSG_" set  to "_Y_"  days."
  26643   "RTN","RCP 332",26,0)
  26644    ;
  26645   "RTN","RCP 332",27,0)
  26646    K X,Y D B MES^XPDUTL (RCMSG)
  26647   "RTN","RCP 332",28,0)
  26648    D:$D(RCMS G("prev"))  MES^XPDUT L("The pre vious valu e was "_$C (34)_RCMSG ("prev")_$ C(34)_".")
  26649   "RTN","RCP 332",29,0)
  26650    ; end TRI CARE EFT P OST PREVEN T DAYS upd ate
  26651   "RTN","RCP 332",30,0)
  26652    ;
  26653   "RTN","RCP 332",31,0)
  26654    ; (#.07)  PHARMACY E FT POST PR EVENT DAYS  [7N] upda te is idem potent if  value null  or in-bou nds
  26655   "RTN","RCP 332",32,0)
  26656    K RCMSG
  26657   "RTN","RCP 332",33,0)
  26658    S RCMSG=" PHARMACY E FT POST PR EVENT DAYS " D  ; RCM SG holds a ction perf ormed
  26659   "RTN","RCP 332",34,0)
  26660    . S X(344 .61,0)=$G( ^RCY(344.6 1,1,0)),Y= $P(X(344.6 1,0),U,7), RCMSG("pre v")=Y
  26661   "RTN","RCP 332",35,0)
  26662    . I Y=""  S RCMSG=RC MSG_" valu e has not  been enter ed. No act ion taken. " Q  ; fie ld is null , nothing  to do
  26663   "RTN","RCP 332",36,0)
  26664    . I (Y>20 )&(Y<100)  S RCMSG=RC MSG_" valu e is "_Y_"  days. No  action tak en." K RCM SG("prev")  Q   ; min imum is 21  days, max imum is 99
  26665   "RTN","RCP 332",37,0)
  26666    . L +^RCY (344.61,1) :DILOCKTM  E  D  Q  ;  exclusive  access
  26667   "RTN","RCP 332",38,0)
  26668    ..  S RCM SG="Error,  unable to  update "_ RCMSG_"  C annot LOCK  entry."
  26669   "RTN","RCP 332",39,0)
  26670    . ; value  is out-of -bounds, f ix it
  26671   "RTN","RCP 332",40,0)
  26672    . N RCFDA ,RCFMERR
  26673   "RTN","RCP 332",41,0)
  26674    . S RCFDA (344.61,"1 ,",.07)=$S (Y<21:21,1 :99)  ; on ly 1 entry  in 344.61
  26675   "RTN","RCP 332",42,0)
  26676    . D FILE^ DIE("","RC FDA","RCFM ERR")
  26677   "RTN","RCP 332",43,0)
  26678    . I $D(RC FMERR) D   Q  ; handl e FileMan  error
  26679   "RTN","RCP 332",44,0)
  26680    ..  S RCM SG=RCMSG_"  not updat ed due to  error."
  26681   "RTN","RCP 332",45,0)
  26682    ..  S X=" RCFMERR" F   S X=$Q(@ X) Q:X=""   S Y=@X D  BMES^XPDUT L(Y)  ; pu t error te xt into lo g
  26683   "RTN","RCP 332",46,0)
  26684    . S X(344 .61,0)=$G( ^RCY(344.6 1,1,0)),Y= +$P(X(344. 61,0),U,7)
  26685   "RTN","RCP 332",47,0)
  26686    . L -^RCY (344.61,1)  S RCMSG=R CMSG_" set  to "_Y_"  days."
  26687   "RTN","RCP 332",48,0)
  26688    ;
  26689   "RTN","RCP 332",49,0)
  26690    K X,Y D:$ L(RCMSG) B MES^XPDUTL (RCMSG)  ;  if RCMSG  null nothi ng was upd ated
  26691   "RTN","RCP 332",50,0)
  26692    D:$D(RCMS G("prev"))  MES^XPDUT L("The pre vious valu e was "_$C (34)_RCMSG ("prev")_$ C(34)_".")
  26693   "RTN","RCP 332",51,0)
  26694    ; end PHA RMACY EFT  POST PREVE NT DAYS up date
  26695   "RTN","RCP 332",52,0)
  26696    ;
  26697   "RTN","RCP 332",53,0)
  26698    D BMES^XP DUTL("PRCA *4.5*332 p ost-instal lation fin ished "_$$ HTE^XLFDT( $H))
  26699   "RTN","RCP 332",54,0)
  26700    Q
  26701   "RTN","RCP 332",55,0)
  26702    ;
  26703   "UP",344.6 1,344.611, -1)
  26704   344.61^2
  26705   "UP",344.6 1,344.611, 0)
  26706   344.611
  26707   "VER")
  26708   8.0^22.2
  26709   "^DD",342, 342,7.09,0 )
  26710   AUTO-AUDIT  TRICARE B ILLS^S^0:N o;1:Yes;^7 ;9^Q
  26711   "^DD",342, 342,7.09,. 1)
  26712   ENABLE AUT O-AUDIT TR ICARE BILL S
  26713   "^DD",342, 342,7.09,3 )
  26714   Enter 1 to  allow aut o-auditing  of Tricar e Bills, 0  to disall ow.
  26715   "^DD",342, 342,7.09,2 1,0)
  26716   ^.001^2^2^ 3181101^^^ ^
  26717   "^DD",342, 342,7.09,2 1,1,0)
  26718   A Yes/No p rompt to a llow a sit e to audit  their Tri care Bills  during
  26719   "^DD",342, 342,7.09,2 1,2,0)
  26720   the AR Nig htly Proce ss.
  26721   "^DD",342, 342,7.09,2 3,0)
  26722   ^.001^2^2^ 3181101^^^ ^
  26723   "^DD",342, 342,7.09,2 3,1,0)
  26724   A Yes/No p rompt to i ndicate if  the site  wishes to  audit thei r Tricare
  26725   "^DD",342, 342,7.09,2 3,2,0)
  26726   bills duri ng the AR  Nightly Pr ocess [PRC A NIGHTLY  PROCESS].
  26727   "^DD",342, 342,7.09," DT")
  26728   3181120
  26729   "^DD",344. 5,344.5,.1 5,0)
  26730   DUPLICATE  INDICATOR^ S^0:NO;1:Y ES;^0;15^Q
  26731   "^DD",344. 5,344.5,.1 5,3)
  26732   Enter '1'  if the mes sage is a  duplicate  transmissi on.
  26733   "^DD",344. 5,344.5,.1 5,21,0)
  26734   ^.001^1^1^ 3180820^^^ ^
  26735   "^DD",344. 5,344.5,.1 5,21,1,0)
  26736   This field  indicates  the incom ing 835 me ssage is a  duplicate  transmiss ion.
  26737   "^DD",344. 5,344.5,.1 5,23,0)
  26738   ^^3^3^3180 820^
  26739   "^DD",344. 5,344.5,.1 5,23,1,0)
  26740   This field  is used i n the fili ng routine s for EFT  835 messag es
  26741   "^DD",344. 5,344.5,.1 5,23,2,0)
  26742   to overrid e the chec ks for dup licates. T he field w ill be aut omatically  
  26743   "^DD",344. 5,344.5,.1 5,23,3,0)
  26744   set by the  system.
  26745   "^DD",344. 5,344.5,.1 5,"DT")
  26746   3181017
  26747   "^DD",344. 61,344.61, .07,0)
  26748   PHARMACY E FT POST PR EVENT DAYS ^NJ2,0^^0; 7^K:+X'=X! (X>99)!(X< 21)!(X?.E1 "."1N.N) X
  26749   "^DD",344. 61,344.61, .07,.1)
  26750   NUMBER OF  DAYS (AGE)  OF UNPOST ED PHARMAC Y EFTS TO  PREVENT PO STING: 
  26751   "^DD",344. 61,344.61, .07,3)
  26752   Enter a nu mber from  21 to 99 i nclusive,  0 decimal  digits.
  26753   "^DD",344. 61,344.61, .07,21,0)
  26754   ^.001^6^6^ 3181004^^^
  26755   "^DD",344. 61,344.61, .07,21,1,0 )
  26756   The number  of calend ar days be yond which  unposted  pharmacy p ayments 
  26757   "^DD",344. 61,344.61, .07,21,2,0 )
  26758   (EFTs) wil l prevent  the user f rom postin g newer ph armacy EFT s without 
  26759   "^DD",344. 61,344.61, .07,21,3,0 )
  26760   posting th e older pa yments fir st.
  26761   "^DD",344. 61,344.61, .07,21,4,0 )
  26762    
  26763   "^DD",344. 61,344.61, .07,21,5,0 )
  26764   The user c an reset t he value t o a number  between 2 1 and 99,  inclusive,
  26765   "^DD",344. 61,344.61, .07,21,6,0 )
  26766   but the us er cannot  delete the  value.
  26767   "^DD",344. 61,344.61, .07,"DEL", 1,0)
  26768   I 1 D EN^D DIOL($C(7) _"This val ue cannot  be deleted !")
  26769   "^DD",344. 61,344.61, .07,"DT")
  26770   3181004
  26771   "^DD",344. 61,344.61, .13,0)
  26772   TRICARE EF T POST PRE VENT DAYS^ NJ2,0^^0;1 3^K:+X'=X! (X>60)!(X< 14)!(X?.E1 "."1N.N) X
  26773   "^DD",344. 61,344.61, .13,.1)
  26774   NUMBER OF  DAYS (AGE)  OF UNPOST ED TRICARE  EFTS TO P REVENT POS TING:
  26775   "^DD",344. 61,344.61, .13,3)
  26776   Enter the  number of  days an EF T can age  before pre venting ne wer EFTs ( between 14  and 60).
  26777   "^DD",344. 61,344.61, .13,21,0)
  26778   ^.001^6^6^ 3180927^^
  26779   "^DD",344. 61,344.61, .13,21,1,0 )
  26780   The number  of calend ar days be yond which  un-posted  Tricare 
  26781   "^DD",344. 61,344.61, .13,21,2,0 )
  26782   payments ( EFTs) will  prevent t he user fr om posting  newer 
  26783   "^DD",344. 61,344.61, .13,21,3,0 )
  26784   medical EF Ts without  posting t he older p ayments fi rst.  
  26785   "^DD",344. 61,344.61, .13,21,4,0 )
  26786                 
  26787   "^DD",344. 61,344.61, .13,21,5,0 )
  26788   A value of  30 is the  initial d efault.  T he user ca n set the  value to a  number
  26789   "^DD",344. 61,344.61, .13,21,6,0 )
  26790   from 14 to  60, inclu sive, but  cannot del ete the va lue.
  26791   "^DD",344. 61,344.61, .13,23,0)
  26792   ^^1^1^3180 927^
  26793   "^DD",344. 61,344.61, .13,23,1,0 )
  26794   This field  has a "DE L" node to  prevent d eletion.
  26795   "^DD",344. 61,344.61, .13,"DEL", 1,0)
  26796   I 1 D EN^D DIOL($C(7) _"This val ue cannot  be deleted !")
  26797   "^DD",344. 61,344.61, .13,"DT")
  26798   3181120
  26799   "^DD",344. 61,344.61, 2,0)
  26800   HISTORY^34 4.611D^^2; 0
  26801   "^DD",344. 61,344.61, 2,21,0)
  26802   ^^5^5^3181 017^
  26803   "^DD",344. 61,344.61, 2,21,1,0)
  26804   The histor y multiple  contains  a log of c hanges to  EDI Lockbo x auto-pos t
  26805   "^DD",344. 61,344.61, 2,21,2,0)
  26806   and auto-d ecrease pa rameters.   The date  and time o f the chan ge, the us er
  26807   "^DD",344. 61,344.61, 2,21,3,0)
  26808   who made t he change  and the ol d and new  values of  the parame ter are
  26809   "^DD",344. 61,344.61, 2,21,4,0)
  26810   stored.  T his inform ation is u sed to pri nt the Aut o Paramete r History
  26811   "^DD",344. 61,344.61, 2,21,5,0)
  26812   Report on  demand.
  26813   "^DD",344. 61,344.61, 26,0)
  26814   TRICARE EF T OVERRIDE ^D^^OVERRI DE;7^S %DT ="ESTX" D  ^%DT S X=Y  K:Y<1 X
  26815   "^DD",344. 61,344.61, 26,3)
  26816   Enter the  precise da te (option al time) r ecorded fo r the Tric are EFT ov erride.
  26817   "^DD",344. 61,344.61, 26,21,0)
  26818   ^^2^2^3180 927^
  26819   "^DD",344. 61,344.61, 26,21,1,0)
  26820   An overrid e will all ow unrestr icted scra tchpad cre ation with in 
  26821   "^DD",344. 61,344.61, 26,21,2,0)
  26822   the ERA Wo rklist opt ion for on e day.
  26823   "^DD",344. 61,344.61, 26,"DT")
  26824   3180927
  26825   "^DD",344. 61,344.61, 27,0)
  26826   USER - TRI CARE OVERR IDE^P200'^ VA(200,^OV ERRIDE;8^Q
  26827   "^DD",344. 61,344.61, 27,.1)
  26828   USER WHO E NTERED THE  TRICARE O VERRIDE
  26829   "^DD",344. 61,344.61, 27,3)
  26830   Enter the  user who e ntered the  Tricare o verride.
  26831   "^DD",344. 61,344.61, 27,21,0)
  26832   ^^2^2^3180 927^
  26833   "^DD",344. 61,344.61, 27,21,1,0)
  26834   A record o f the pers on who ent ered the T ricare ove rride is n eeded for
  26835   "^DD",344. 61,344.61, 27,21,2,0)
  26836   auditing p urposes.
  26837   "^DD",344. 61,344.61, 27,"DT")
  26838   3180927
  26839   "^DD",344. 61,344.61, 28,0)
  26840   COMMENT -  TRICARE OV ERRIDE^FJ5 0^^OVERRID E;9^K:$L(X )>50!($L(X )<1) X
  26841   "^DD",344. 61,344.61, 28,.1)
  26842   COMMENT EX PLAINING T HE TRICARE  OVERRIDE
  26843   "^DD",344. 61,344.61, 28,3)
  26844   Enter the  reason for  the Trica re overrid e, 1-50 ch aracters.
  26845   "^DD",344. 61,344.61, 28,21,0)
  26846   ^^2^2^3180 927^
  26847   "^DD",344. 61,344.61, 28,21,1,0)
  26848   The reason  for enter ing the Tr icare over ride must  be recorde d
  26849   "^DD",344. 61,344.61, 28,21,2,0)
  26850   for auditi ng purpose s.
  26851   "^DD",344. 61,344.61, 28,"DT")
  26852   3180927
  26853   "^DD",344. 61,344.611 ,0)
  26854   HISTORY SU B-FIELD^^4 ^6
  26855   "^DD",344. 61,344.611 ,0,"NM","H ISTORY")
  26856  
  26857   "^DD",344. 61,344.611 ,.01,0)
  26858   DATE^MMD^^ 0;1^S %DT= "ESTX" D ^ %DT S X=Y  K:X<1 X
  26859   "^DD",344. 61,344.611 ,.01,1,0)
  26860   ^.1
  26861   "^DD",344. 61,344.611 ,.01,1,1,0 )
  26862   344.611^B
  26863   "^DD",344. 61,344.611 ,.01,1,1,1 )
  26864   S ^RCY(344 .61,DA(1), 2,"B",$E(X ,1,30),DA) =""
  26865   "^DD",344. 61,344.611 ,.01,1,1,2 )
  26866   K ^RCY(344 .61,DA(1), 2,"B",$E(X ,1,30),DA)
  26867   "^DD",344. 61,344.611 ,.01,3)
  26868   Enter the  date/time  the EDI Lo ckbox para meter was  changed.
  26869   "^DD",344. 61,344.611 ,.01,21,0)
  26870   ^^1^1^3180 720^
  26871   "^DD",344. 61,344.611 ,.01,21,1, 0)
  26872   This field  will be a utomatical ly populat ed by the  system.
  26873   "^DD",344. 61,344.611 ,.01,"DT")
  26874   3180730
  26875   "^DD",344. 61,344.611 ,.02,0)
  26876   USER^P200' ^VA(200,^0 ;2^Q
  26877   "^DD",344. 61,344.611 ,.02,3)
  26878   Enter the  person who  changed t he EDI Loc kbox param eter
  26879   "^DD",344. 61,344.611 ,.02,21,0)
  26880   ^^1^1^3180 720^
  26881   "^DD",344. 61,344.611 ,.02,21,1, 0)
  26882   This field  will be a utomatical ly populat ed by the  system.
  26883   "^DD",344. 61,344.611 ,.02,"DT")
  26884   3180730
  26885   "^DD",344. 61,344.611 ,1,0)
  26886   PARAMETER^ FJ50^^0;3^ K:$L(X)>50 !($L(X)<1)  X
  26887   "^DD",344. 61,344.611 ,1,3)
  26888   Enter the  descriptio n of the p arameter t hat was ch anged, 1 t o 50 chara cters.
  26889   "^DD",344. 61,344.611 ,1,21,0)
  26890   ^^1^1^3181 017^
  26891   "^DD",344. 61,344.611 ,1,21,1,0)
  26892   This field  will be a utomatical ly populat ed by the  system.
  26893   "^DD",344. 61,344.611 ,1,"DT")
  26894   3181017
  26895   "^DD",344. 61,344.611 ,2,0)
  26896   DETAIL^FJ6 0^^0;4^K:$ L(X)>60!($ L(X)<1) X
  26897   "^DD",344. 61,344.611 ,2,3)
  26898   Enter the  payer or C ARC code a ssociated  with this  change, 1  to 60 char acters.
  26899   "^DD",344. 61,344.611 ,2,21,0)
  26900   ^^1^1^3180 720^^
  26901   "^DD",344. 61,344.611 ,2,21,1,0)
  26902   This field  will be a utomatical ly populat ed by the  system.
  26903   "^DD",344. 61,344.611 ,2,"DT")
  26904   3181017
  26905   "^DD",344. 61,344.611 ,3,0)
  26906   OLD VALUE^ FJ20^^0;5^ K:$L(X)>20 !($L(X)<1)  X
  26907   "^DD",344. 61,344.611 ,3,3)
  26908   Enter the  old value  of the par ameter tha t was chan ged, 1 to  20 charact ers.
  26909   "^DD",344. 61,344.611 ,3,21,0)
  26910   ^^1^1^3180 720^^
  26911   "^DD",344. 61,344.611 ,3,21,1,0)
  26912   This field  will be a utomatical ly populat ed by the  system.
  26913   "^DD",344. 61,344.611 ,3,"DT")
  26914   3181017
  26915   "^DD",344. 61,344.611 ,4,0)
  26916   NEW VALUE^ FJ20^^0;6^ K:$L(X)>20 !($L(X)<1)  X
  26917   "^DD",344. 61,344.611 ,4,3)
  26918   Enter the  new value  of the par ameter tha t was chan ged, 1 to  20 charact ers.
  26919   "^DD",344. 61,344.611 ,4,21,0)
  26920   ^^1^1^3180 720^
  26921   "^DD",344. 61,344.611 ,4,21,1,0)
  26922   This field  will be a utomatical ly populat ed by the  system.
  26923   "^DD",344. 61,344.611 ,4,"DT")
  26924   3181017
  26925   **INSTALL  NAME**
  26926   IB*2.0*633
  26927   "BLD",1106 5,0)
  26928   IB*2.0*633 ^INTEGRATE D BILLING^ 0^3181214^ y
  26929   "BLD",1106 5,4,0)
  26930   ^9.64PA^^
  26931   "BLD",1106 5,6.3)
  26932   15
  26933   "BLD",1106 5,"KRN",0)
  26934   ^9.67PA^77 9.2^20
  26935   "BLD",1106 5,"KRN",.4 ,0)
  26936   .4
  26937   "BLD",1106 5,"KRN",.4 01,0)
  26938   .401
  26939   "BLD",1106 5,"KRN",.4 02,0)
  26940   .402
  26941   "BLD",1106 5,"KRN",.4 03,0)
  26942   .403
  26943   "BLD",1106 5,"KRN",.5 ,0)
  26944   .5
  26945   "BLD",1106 5,"KRN",.8 4,0)
  26946   .84
  26947   "BLD",1106 5,"KRN",3. 6,0)
  26948   3.6
  26949   "BLD",1106 5,"KRN",3. 8,0)
  26950   3.8
  26951   "BLD",1106 5,"KRN",9. 2,0)
  26952   9.2
  26953   "BLD",1106 5,"KRN",9. 8,0)
  26954   9.8
  26955   "BLD",1106 5,"KRN",9. 8,"NM",0)
  26956   ^9.68A^3^3
  26957   "BLD",1106 5,"KRN",9. 8,"NM",1,0 )
  26958   IBCEOB0^^0 ^B98733929
  26959   "BLD",1106 5,"KRN",9. 8,"NM",2,0 )
  26960   IBJTEP^^0^ B170521408
  26961   "BLD",1106 5,"KRN",9. 8,"NM",3,0 )
  26962   IBJTEP1^^0 ^B58092745
  26963   "BLD",1106 5,"KRN",9. 8,"NM","B" ,"IBCEOB0" ,1)
  26964  
  26965   "BLD",1106 5,"KRN",9. 8,"NM","B" ,"IBJTEP", 2)
  26966  
  26967   "BLD",1106 5,"KRN",9. 8,"NM","B" ,"IBJTEP1" ,3)
  26968  
  26969   "BLD",1106 5,"KRN",19 ,0)
  26970   19
  26971   "BLD",1106 5,"KRN",19 .1,0)
  26972   19.1
  26973   "BLD",1106 5,"KRN",10 1,0)
  26974   101
  26975   "BLD",1106 5,"KRN",40 9.61,0)
  26976   409.61
  26977   "BLD",1106 5,"KRN",77 1,0)
  26978   771
  26979   "BLD",1106 5,"KRN",77 9.2,0)
  26980   779.2
  26981   "BLD",1106 5,"KRN",87 0,0)
  26982   870
  26983   "BLD",1106 5,"KRN",89 89.51,0)
  26984   8989.51
  26985   "BLD",1106 5,"KRN",89 89.52,0)
  26986   8989.52
  26987   "BLD",1106 5,"KRN",89 94,0)
  26988   8994
  26989   "BLD",1106 5,"KRN","B ",.4,.4)
  26990  
  26991   "BLD",1106 5,"KRN","B ",.401,.40 1)
  26992  
  26993   "BLD",1106 5,"KRN","B ",.402,.40 2)
  26994  
  26995   "BLD",1106 5,"KRN","B ",.403,.40 3)
  26996  
  26997   "BLD",1106 5,"KRN","B ",.5,.5)
  26998  
  26999   "BLD",1106 5,"KRN","B ",.84,.84)
  27000  
  27001   "BLD",1106 5,"KRN","B ",3.6,3.6)
  27002  
  27003   "BLD",1106 5,"KRN","B ",3.8,3.8)
  27004  
  27005   "BLD",1106 5,"KRN","B ",9.2,9.2)
  27006  
  27007   "BLD",1106 5,"KRN","B ",9.8,9.8)
  27008  
  27009   "BLD",1106 5,"KRN","B ",19,19)
  27010  
  27011   "BLD",1106 5,"KRN","B ",19.1,19. 1)
  27012  
  27013   "BLD",1106 5,"KRN","B ",101,101)
  27014  
  27015   "BLD",1106 5,"KRN","B ",409.61,4 09.61)
  27016  
  27017   "BLD",1106 5,"KRN","B ",771,771)
  27018  
  27019   "BLD",1106 5,"KRN","B ",779.2,77 9.2)
  27020  
  27021   "BLD",1106 5,"KRN","B ",870,870)
  27022  
  27023   "BLD",1106 5,"KRN","B ",8989.51, 8989.51)
  27024  
  27025   "BLD",1106 5,"KRN","B ",8989.52, 8989.52)
  27026  
  27027   "BLD",1106 5,"KRN","B ",8994,899 4)
  27028  
  27029   "BLD",1106 5,"QUES",0 )
  27030   ^9.62^^
  27031   "BLD",1106 5,"REQB",0 )
  27032   ^9.611^2^2
  27033   "BLD",1106 5,"REQB",1 ,0)
  27034   IB*2.0*516 ^1
  27035   "BLD",1106 5,"REQB",2 ,0)
  27036   IB*2.0*609 ^1
  27037   "BLD",1106 5,"REQB"," B","IB*2.0 *516",1)
  27038  
  27039   "BLD",1106 5,"REQB"," B","IB*2.0 *609",2)
  27040  
  27041   "MBREQ")
  27042   0
  27043   "PKG",230, -1)
  27044   1^1
  27045   "PKG",230, 0)
  27046   INTEGRATED  BILLING^I B^INTEGRAT ED BILLING
  27047   "PKG",230, 22,0)
  27048   ^9.49I^1^1
  27049   "PKG",230, 22,1,0)
  27050   2.0^294032 1^2940525
  27051   "PKG",230, 22,1,"PAH" ,1,0)
  27052   633^318121 4
  27053   "QUES","XP F1",0)
  27054   Y
  27055   "QUES","XP F1","??")
  27056   ^D REP^XPD H
  27057   "QUES","XP F1","A")
  27058   Shall I wr ite over y our |FLAG|  File
  27059   "QUES","XP F1","B")
  27060   YES
  27061   "QUES","XP F1","M")
  27062   D XPF1^XPD IQ
  27063   "QUES","XP F2",0)
  27064   Y
  27065   "QUES","XP F2","??")
  27066   ^D DTA^XPD H
  27067   "QUES","XP F2","A")
  27068   Want my da ta |FLAG|  yours
  27069   "QUES","XP F2","B")
  27070   YES
  27071   "QUES","XP F2","M")
  27072   D XPF2^XPD IQ
  27073   "QUES","XP I1",0)
  27074   YO
  27075   "QUES","XP I1","??")
  27076   ^D INHIBIT ^XPDH
  27077   "QUES","XP I1","A")
  27078   Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  27079   "QUES","XP I1","B")
  27080   NO
  27081   "QUES","XP I1","M")
  27082   D XPI1^XPD IQ
  27083   "QUES","XP M1",0)
  27084   PO^VA(200, :EM
  27085   "QUES","XP M1","??")
  27086   ^D MG^XPDH
  27087   "QUES","XP M1","A")
  27088   Enter the  Coordinato r for Mail  Group '|F LAG|'
  27089   "QUES","XP M1","B")
  27090  
  27091   "QUES","XP M1","M")
  27092   D XPM1^XPD IQ
  27093   "QUES","XP O1",0)
  27094   Y
  27095   "QUES","XP O1","??")
  27096   ^D MENU^XP DH
  27097   "QUES","XP O1","A")
  27098   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  27099   "QUES","XP O1","B")
  27100   NO
  27101   "QUES","XP O1","M")
  27102   D XPO1^XPD IQ
  27103   "QUES","XP Z1",0)
  27104   Y
  27105   "QUES","XP Z1","??")
  27106   ^D OPT^XPD H
  27107   "QUES","XP Z1","A")
  27108   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  27109   "QUES","XP Z1","B")
  27110   NO
  27111   "QUES","XP Z1","M")
  27112   D XPZ1^XPD IQ
  27113   "QUES","XP Z2",0)
  27114   Y
  27115   "QUES","XP Z2","??")
  27116   ^D RTN^XPD H
  27117   "QUES","XP Z2","A")
  27118   Want to MO VE routine s to other  CPUs
  27119   "QUES","XP Z2","B")
  27120   NO
  27121   "QUES","XP Z2","M")
  27122   D XPZ2^XPD IQ
  27123   "RTN")
  27124   3
  27125   "RTN","IBC EOB0")
  27126   0^1^B98733 929
  27127   "RTN","IBC EOB0",1,0)
  27128   IBCEOB0 ;A LB/TMP/PJH  - 835 EDI  EOB MSG P ROCESSING  ; 8/24/10  7:23pm
  27129   "RTN","IBC EOB0",2,0)
  27130    ;;2.0;INT EGRATED BI LLING;**13 5,280,155, 431,488,51 6,633**;21 -MAR-94;Bu ild 15
  27131   "RTN","IBC EOB0",3,0)
  27132    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  27133   "RTN","IBC EOB0",4,0)
  27134    Q
  27135   "RTN","IBC EOB0",5,0)
  27136    ;
  27137   "RTN","IBC EOB0",6,0)
  27138   LINE() ;Ex tract Prov ider Line  Reference  from 42 re cord
  27139   "RTN","IBC EOB0",7,0)
  27140    N SUB,NOD E,VAL
  27141   "RTN","IBC EOB0",8,0)
  27142    S VAL="", SUB=IBA1 ;  from loop  in UPD361 1^IBCEOB
  27143   "RTN","IBC EOB0",9,0)
  27144    ;IB*2.0*5 16/TAZ - Q uit when a nother RT  40 is enco untered to  prevent g roup of
  27145   "RTN","IBC EOB0",10,0 )
  27146    ;mismatch ed procedu res
  27147   "RTN","IBC EOB0",11,0 )
  27148    F  S SUB= $O(@IBFILE @(SUB)) Q: SUB=""  D   Q:(+NODE> 42)!(+NODE =40)
  27149   "RTN","IBC EOB0",12,0 )
  27150    .S NODE=$ G(@IBFILE@ (SUB,0))
  27151   "RTN","IBC EOB0",13,0 )
  27152    .S:NODE[" RAW DATA"  NODE=$P(NO DE," ",3,9 9)
  27153   "RTN","IBC EOB0",14,0 )
  27154    .Q:+NODE' =42  S VAL =$P(NODE,U ,5)
  27155   "RTN","IBC EOB0",15,0 )
  27156    Q VAL
  27157   "RTN","IBC EOB0",16,0 )
  27158    ;
  27159   "RTN","IBC EOB0",17,0 )
  27160   30(IB0,IBE OB,IBOK) ;  Process r ecord type  30 for EO B
  27161   "RTN","IBC EOB0",18,0 )
  27162    ; IB0 = t he record  being proc essed
  27163   "RTN","IBC EOB0",19,0 )
  27164    ; IBEOB =  the ien o f the EOB  entry in f ile 361.1
  27165   "RTN","IBC EOB0",20,0 )
  27166    ; IBOK =  Returned a s 1 if rec ord filed  OK, 0 if e rror occur red
  27167   "RTN","IBC EOB0",21,0 )
  27168    ;
  27169   "RTN","IBC EOB0",22,0 )
  27170    N A
  27171   "RTN","IBC EOB0",23,0 )
  27172    S A="3;4. 01;0;1;1^5 ;4.02;0;1; 1^6;4.03;1 ;0;0^7;4.0 5;1;0;0^8; 4.06;1;0;0 ^9;4.07;1; 0;0^10;4.0 8;1;0;0^11 ;4.09;1;0; 0^12;4.1;1 ;0;0^13;4. 11;1;0;0^1 4;4.19;0;1 ;1"
  27173   "RTN","IBC EOB0",24,0 )
  27174    ;
  27175   "RTN","IBC EOB0",25,0 )
  27176    S IBOK=$$ STORE^IBCE OB1(A,IB0, IBEOB)
  27177   "RTN","IBC EOB0",26,0 )
  27178    I 'IBOK S  ^TMP(IBEG BL,$J,+$O( ^TMP(IBEGB L,$J,""),- 1)+1)="Bad  MEDICARE  Inpt Adjud ication da ta"
  27179   "RTN","IBC EOB0",27,0 )
  27180   Q30 Q
  27181   "RTN","IBC EOB0",28,0 )
  27182    ;
  27183   "RTN","IBC EOB0",29,0 )
  27184   40(IB0,IBE OB,IBOK) ;  Process r ecord type  40 for EO B
  27185   "RTN","IBC EOB0",30,0 )
  27186    ; IB0 = t he record  being proc essed
  27187   "RTN","IBC EOB0",31,0 )
  27188    ; IBEOB =  the ien o f the EOB  entry in f ile 361.1
  27189   "RTN","IBC EOB0",32,0 )
  27190    ; IBOK =  Returned a s 1 if rec ord filed  OK, 0 if e rror occur red
  27191   "RTN","IBC EOB0",33,0 )
  27192    ;
  27193   "RTN","IBC EOB0",34,0 )
  27194    ; IBZDATA  is also a ssumed to  exist or i f not, it  is created  in FINDLN
  27195   "RTN","IBC EOB0",35,0 )
  27196    ;
  27197   "RTN","IBC EOB0",36,0 )
  27198    N A,LEVEL ,IBSEQ,IBD A,IBPC,IBL REF,IBIFN, Q,X,Y,DA,D D,DO,DIC,D LAYGO,PLRE F,ERRCOD
  27199   "RTN","IBC EOB0",37,0 )
  27200    K ^TMP($J ,40) ; the  entry # f or corresp onding 41,  42, and 4 5 records
  27201   "RTN","IBC EOB0",38,0 )
  27202    ;
  27203   "RTN","IBC EOB0",39,0 )
  27204    S IBIFN=+ $G(^IBM(36 1.1,IBEOB, 0))
  27205   "RTN","IBC EOB0",40,0 )
  27206    L +^IBM(3 61.1,IBEOB ,15):0 I $ T S IBSEQ= +$O(^IBM(3 61.1,IBEOB ,15," "),- 1)+1
  27207   "RTN","IBC EOB0",41,0 )
  27208    I '$G(IBS EQ) S ^TMP (IBEGBL,$J ,+$O(^TMP( IBEGBL,$J, ""),-1)+1) ="Record l ock failur e - could  not acquir e next ser vice line  number" G  Q40
  27209   "RTN","IBC EOB0",42,0 )
  27210    ;
  27211   "RTN","IBC EOB0",43,0 )
  27212    ; Update  the 40 rec ord data a  little bi t (pieces  3/4/16)
  27213   "RTN","IBC EOB0",44,0 )
  27214    I $P(IB0, U,21)="NU"  S $P(IB0, U,4)=$P(IB 0,U,3),$P( IB0,U,3)=" "
  27215   "RTN","IBC EOB0",45,0 )
  27216    S $P(IB0, U,16)=$S(+ $P(IB0,U,1 6):$P(IB0, U,16)/100, 1:+$P(IB0, U,18)/100)
  27217   "RTN","IBC EOB0",46,0 )
  27218    I $P(IB0, U,4)?1.N S  $P(IB0,U, 4)=+$P(IB0 ,U,4)
  27219   "RTN","IBC EOB0",47,0 )
  27220    ;
  27221   "RTN","IBC EOB0",48,0 )
  27222    ; Find th e line ite m from ori ginal bill  for this  adjustment
  27223   "RTN","IBC EOB0",49,0 )
  27224    S PLREF=$ S('HIPAA:$ P(IB0,U,22 ),1:$$LINE ()) ; old  format fro m 40 recor d, new for mat from 4 2
  27225   "RTN","IBC EOB0",50,0 )
  27226    S ERRCOD= 0
  27227   "RTN","IBC EOB0",51,0 )
  27228    S IBLREF= +$$FINDLN^ IBCEOB1(IB 0,IBEOB,.I BZDATA,+PL REF,.ERRCO D)
  27229   "RTN","IBC EOB0",52,0 )
  27230    I 'IBLREF  D  G Q40
  27231   "RTN","IBC EOB0",53,0 )
  27232    . N Z,Z0, CT,ETEXT
  27233   "RTN","IBC EOB0",54,0 )
  27234    . S EFLAG =0,ETEXT=" "
  27235   "RTN","IBC EOB0",55,0 )
  27236    . ;;S ^TM P(IBEGBL,$ J,+$O(^TMP (IBEGBL,$J ,""),-1)+1 )="Service  line deta il could n ot be matc hed to a b illed item "
  27237   "RTN","IBC EOB0",56,0 )
  27238    . S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= " "
  27239   "RTN","IBC EOB0",57,0 )
  27240    . S ETEXT =$P("Reven ue Code^Pr ocedure Co de^Amount  of Units^C harge Amou nt^Procedu re Code Mo difier",U, +ERRCOD)
  27241   "RTN","IBC EOB0",58,0 )
  27242    . I ETEXT ="" S ETEX T="Data"
  27243   "RTN","IBC EOB0",59,0 )
  27244    . S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= $$ERRTXT(E TEXT,IBEOB ) ; IB*2.0 *633
  27245   "RTN","IBC EOB0",60,0 )
  27246    . S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= " "
  27247   "RTN","IBC EOB0",61,0 )
  27248    . D DET40 ^IBCEOB00( IB0,.Z0,ER RCOD)
  27249   "RTN","IBC EOB0",62,0 )
  27250    . S CT=+$ O(^TMP(IBE GBL,$J,"") ,-1),Z=0 F   S Z=$O(Z 0(Z)) Q:'Z   S CT=CT+ 1,^TMP(IBE GBL,$J,CT) =Z0(Z)
  27251   "RTN","IBC EOB0",63,0 )
  27252    ;
  27253   "RTN","IBC EOB0",64,0 )
  27254    S DIC="^I BM(361.1," _IBEOB_",1 5,",DIC(0) ="L",DLAYG O=361.115, DA(1)=IBEO B
  27255   "RTN","IBC EOB0",65,0 )
  27256    S X=IBSEQ
  27257   "RTN","IBC EOB0",66,0 )
  27258    S DIC("DR ")=".12/// /"_+IBLREF _$S($P(IBL REF,U,2)=" ":"",1:";. 15////"_$P (IBLREF,U, 2))_";.16/ ///"_$$DAT E^IBCEU($P (IB0,U,19) )_$S($P(IB 0,U,20):"; .17////"_$ $DATE^IBCE U($P(IB0,U ,20)),1:"" )
  27259   "RTN","IBC EOB0",67,0 )
  27260    D FILE^DI CN K DIC,D O,DD,DLAYG O ;Add a n ew LINE LE VEL ADJUST MENT ('SVC ')
  27261   "RTN","IBC EOB0",68,0 )
  27262    I Y<0 S ^ TMP(IBEGBL ,$J,+$O(^T MP(IBEGBL, $J,""),-1) +1)="Could  not add a  LINE LEVE L ADJUSTME NT ("_IBSE Q_")" G Q4 0
  27263   "RTN","IBC EOB0",69,0 )
  27264    ;
  27265   "RTN","IBC EOB0",70,0 )
  27266    L -^IBM(3 61.1,IBEOB ,15)
  27267   "RTN","IBC EOB0",71,0 )
  27268    ;
  27269   "RTN","IBC EOB0",72,0 )
  27270    S LEVEL=1 5.1,LEVEL( 0)=+Y,LEVE L(1)=IBEOB ,LEVEL("DI E")="^IBM( 361.1,"_IB EOB_",15,"
  27271   "RTN","IBC EOB0",73,0 )
  27272    S A="3;.0 4;0;0;0^4; .1;0;0;0^9 ;.09;0;0;0 ^17;.03;1; 0;0^18;.11 ;0;1;D2^21 ;.18;0;0;0 "
  27273   "RTN","IBC EOB0",74,0 )
  27274    I '$P(IB0 ,U,18),$P( IB0,U,16)  S $P(A,U,5 )="16;.11; 0;1;1"
  27275   "RTN","IBC EOB0",75,0 )
  27276    I $$STORE ^IBCEOB1(A ,IB0,IBEOB ,.LEVEL) S  ^TMP($J,4 0)=LEVEL(0 ),IBOK=1
  27277   "RTN","IBC EOB0",76,0 )
  27278    I '$G(IBO K) S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= "Bad data  for line l evel adjus tment "_IB SEQ G Q40
  27279   "RTN","IBC EOB0",77,0 )
  27280    ;
  27281   "RTN","IBC EOB0",78,0 )
  27282    ; Store m odifiers i n multiple
  27283   "RTN","IBC EOB0",79,0 )
  27284    S DIC="^I BM(361.1," _IBEOB_",1 5,"_LEVEL( 0)_",2,",D IC(0)="L", DLAYGO=361 .1152,DA(2 )=IBEOB,DA (1)=LEVEL( 0)
  27285   "RTN","IBC EOB0",80,0 )
  27286    F Q=5:1:8  S X=$P(IB 0,U,Q) I X '="" D FIL E^DICN K D O,DD I Y<0  S IBOK=0  Q
  27287   "RTN","IBC EOB0",81,0 )
  27288    K DLAYGO, DIC,DR,DA
  27289   "RTN","IBC EOB0",82,0 )
  27290    I '$G(IBO K) S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= "Could not  file modi fier data  for line l evel adjus tment "_IB SEQ G Q40
  27291   "RTN","IBC EOB0",83,0 )
  27292   Q40 Q
  27293   "RTN","IBC EOB0",84,0 )
  27294    ;
  27295   "RTN","IBC EOB0",85,0 )
  27296   41(IB0,IBE OB,IBOK) ;  Process r ecord type  41 for EO B
  27297   "RTN","IBC EOB0",86,0 )
  27298    ; IB0 = t he record  being proc essed
  27299   "RTN","IBC EOB0",87,0 )
  27300    ; IBEOB =  the ien o f the EOB  entry in f ile 361.1
  27301   "RTN","IBC EOB0",88,0 )
  27302    ; IBOK =  Returned a s 1 if rec ord filed  OK, 0 if e rror occur red
  27303   "RTN","IBC EOB0",89,0 )
  27304    ;
  27305   "RTN","IBC EOB0",90,0 )
  27306    N DA,DR,D IE,X,Y,Z,Z 0,CT
  27307   "RTN","IBC EOB0",91,0 )
  27308    I '$G(^TM P($J,40))  D  G Q41
  27309   "RTN","IBC EOB0",92,0 )
  27310    . S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= "Service l ine adjust ment (EEOB  Record 41 ) has no m atching se rvice line "
  27311   "RTN","IBC EOB0",93,0 )
  27312    . D DET4X ^IBCEOB00( 41,IB0,.Z0 )
  27313   "RTN","IBC EOB0",94,0 )
  27314    . S CT=+$ O(^TMP(IBE GBL,$J,"") ,-1),Z=0 F   S Z=$O(Z 0(Z)) Q:'Z   S CT=CT+ 1,^TMP(IBE GBL,$J,CT) =Z0(Z)
  27315   "RTN","IBC EOB0",95,0 )
  27316    ;
  27317   "RTN","IBC EOB0",96,0 )
  27318    S DR="",I BOK=1
  27319   "RTN","IBC EOB0",97,0 )
  27320    S DA=+^TM P($J,40),D A(1)=IBEOB
  27321   "RTN","IBC EOB0",98,0 )
  27322    S DIE="^I BM(361.1," _DA(1)_",1 5,"
  27323   "RTN","IBC EOB0",99,0 )
  27324    I +$P(IB0 ,U,3) S DR =".13///"_ $$DOLLAR^I BCEOB($P(I B0,U,3))
  27325   "RTN","IBC EOB0",100, 0)
  27326    I +$P(IB0 ,U,4) S DR =DR_$S(DR= "":"",1:"; ")_".14/// "_$$DOLLAR ^IBCEOB($P (IB0,U,4))
  27327   "RTN","IBC EOB0",101, 0)
  27328    I DR'=""  D ^DIE S I BOK=($D(Y) =0)
  27329   "RTN","IBC EOB0",102, 0)
  27330    I '$G(IBO K) S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= "Mismatche d data for  service l ine adjust ment-2 (EE OB Record  41)"
  27331   "RTN","IBC EOB0",103, 0)
  27332    ;
  27333   "RTN","IBC EOB0",104, 0)
  27334    ; For Med icare MRA' s only:
  27335   "RTN","IBC EOB0",105, 0)
  27336    ; If the  Allowed Am ount field  is presen t, then we  need to f ile an
  27337   "RTN","IBC EOB0",106, 0)
  27338    ; adjustm ent:  Grou p code PR,  Reason co de AAA, Am ount, Quan tity, and
  27339   "RTN","IBC EOB0",107, 0)
  27340    ; Reason  Text.  Thi s is data  normally f ound on th e 45 recor d, so we'r e
  27341   "RTN","IBC EOB0",108, 0)
  27342    ; going t o create o ur own "45 " record a nd file it .
  27343   "RTN","IBC EOB0",109, 0)
  27344    ;
  27345   "RTN","IBC EOB0",110, 0)
  27346    I $P($G(^ IBM(361.1, IBEOB,0)), U,4)=1,+$P (IB0,U,3)  D
  27347   "RTN","IBC EOB0",111, 0)
  27348    . N IB45, IBSAV40
  27349   "RTN","IBC EOB0",112, 0)
  27350    . S IB45= 45_U_$P(IB 0,U,2)_U_" PR"_U_"AAA "_U_$P(IB0 ,U,3)_U_"0 000000001"
  27351   "RTN","IBC EOB0",113, 0)
  27352    . S IB45= IB45_U_"Al lowed Amou nt"
  27353   "RTN","IBC EOB0",114, 0)
  27354    . S IBSAV 40=$G(^TMP ($J,40))
  27355   "RTN","IBC EOB0",115, 0)
  27356    . D 45(IB 45,IBEOB,. IBOK)
  27357   "RTN","IBC EOB0",116, 0)
  27358    . S ^TMP( $J,40)=IBS AV40
  27359   "RTN","IBC EOB0",117, 0)
  27360    . I '$G(I BOK) S ^TM P(IBEGBL,$ J,+$O(^TMP (IBEGBL,$J ,""),-1)+1 )="Could n ot file th e PR-AAA a djustment  for the Al lowed Amou nt at line  "_+^TMP($ J,40)
  27361   "RTN","IBC EOB0",118, 0)
  27362    . Q
  27363   "RTN","IBC EOB0",119, 0)
  27364    ;
  27365   "RTN","IBC EOB0",120, 0)
  27366   Q41 Q
  27367   "RTN","IBC EOB0",121, 0)
  27368    ;
  27369   "RTN","IBC EOB0",122, 0)
  27370   42(IB0,IBE OB,IBOK) ;  Process r ecord type  42 for EO
  27371   "RTN","IBC EOB0",123, 0)
  27372    ; IB0 = t he record  being proc essed
  27373   "RTN","IBC EOB0",124, 0)
  27374    ; IBEOB =  the ien o f the EOB  entry in f ile 361.1
  27375   "RTN","IBC EOB0",125, 0)
  27376    ; IBOK =  Returned a s 1 if rec ord filed  OK, 0 if e rror occur red
  27377   "RTN","IBC EOB0",126, 0)
  27378    ;
  27379   "RTN","IBC EOB0",127, 0)
  27380    N DO,DD,D LAYGO,DIC, DA,X,Y,Z,Z 0,CT
  27381   "RTN","IBC EOB0",128, 0)
  27382    S IBOK=0
  27383   "RTN","IBC EOB0",129, 0)
  27384    I '$G(^TM P($J,40))  D  G Q42
  27385   "RTN","IBC EOB0",130, 0)
  27386    . S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= "Service l ine adjust ment (EEOB  Record 42 ) has no m atching se rvice line "
  27387   "RTN","IBC EOB0",131, 0)
  27388    . D DET4X ^IBCEOB00( 42,IB0,.Z0 )
  27389   "RTN","IBC EOB0",132, 0)
  27390    . S CT=+$ O(^TMP(IBE GBL,$J,"") ,-1),Z=0 F   S Z=$O(Z 0(Z)) Q:'Z   S CT=CT+ 1,^TMP(IBE GBL,$J,CT) =Z0(Z)
  27391   "RTN","IBC EOB0",133, 0)
  27392    ;
  27393   "RTN","IBC EOB0",134, 0)
  27394    K DO,DD,D LAYGO
  27395   "RTN","IBC EOB0",135, 0)
  27396    S IBOK=1
  27397   "RTN","IBC EOB0",136, 0)
  27398    S DA(1)=+ ^TMP($J,40 ),DA(2)=IB EOB
  27399   "RTN","IBC EOB0",137, 0)
  27400    S X=+$O(^ IBM(361.1, DA(2),15,D A(1),4," " ),-1)+1,DI C="^IBM(36 1.1,"_DA(2 )_",15,"_D A(1)_",4," ,DIC(0)="L ",DLAYGO=3 61.1154
  27401   "RTN","IBC EOB0",138, 0)
  27402    S DIC("DR ")=$S($P(I B0,U,3)'=" ":".02//// "_$P(IB0,U ,3),1:"")
  27403   "RTN","IBC EOB0",139, 0)
  27404    I $P(IB0, U,4)'="" S :$L(DIC("D R")) DIC(" DR")=DIC(" DR")_";" S  DIC("DR") =DIC("DR") _".03////" _$TR($P(IB 0,U,4),";" ," ")
  27405   "RTN","IBC EOB0",140, 0)
  27406    D FILE^DI CN K DO,DD ,DLAYGO
  27407   "RTN","IBC EOB0",141, 0)
  27408    I Y'>0 S  IBOK=0
  27409   "RTN","IBC EOB0",142, 0)
  27410    I '$G(IBO K) S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= "Mismatche d data for  service l ine adjust ment-3 (EE OB Record  42)"
  27411   "RTN","IBC EOB0",143, 0)
  27412    ;
  27413   "RTN","IBC EOB0",144, 0)
  27414    ; For Med icare MRA' s only:
  27415   "RTN","IBC EOB0",145, 0)
  27416    ; Process  and store  the line  level rema rk code as  an LQ klu dge line
  27417   "RTN","IBC EOB0",146, 0)
  27418    ; level a djustment.
  27419   "RTN","IBC EOB0",147, 0)
  27420    ;
  27421   "RTN","IBC EOB0",148, 0)
  27422    I $P($G(^ IBM(361.1, IBEOB,0)), U,4)=1,$P( IB0,U,3)'= "" D
  27423   "RTN","IBC EOB0",149, 0)
  27424    . N IB45, IBSAV40
  27425   "RTN","IBC EOB0",150, 0)
  27426    . S IB45= 45_U_$P(IB 0,U,2)_U_" LQ"_U_$P(I B0,U,3)_U_ 0_U_0_U_$P (IB0,U,4)
  27427   "RTN","IBC EOB0",151, 0)
  27428    . S IBSAV 40=$G(^TMP ($J,40))
  27429   "RTN","IBC EOB0",152, 0)
  27430    . D 45(IB 45,IBEOB,. IBOK)
  27431   "RTN","IBC EOB0",153, 0)
  27432    . S ^TMP( $J,40)=IBS AV40
  27433   "RTN","IBC EOB0",154, 0)
  27434    . I '$G(I BOK) S ^TM P(IBEGBL,$ J,+$O(^TMP (IBEGBL,$J ,""),-1)+1 )="Could n ot file th e LQ-remar k code adj ustment at  line "_+^ TMP($J,40)
  27435   "RTN","IBC EOB0",155, 0)
  27436    . Q
  27437   "RTN","IBC EOB0",156, 0)
  27438   Q42 Q
  27439   "RTN","IBC EOB0",157, 0)
  27440    ;
  27441   "RTN","IBC EOB0",158, 0)
  27442   45(IB0,IBE OB,IBOK) ;  Process r ecord type  45 for EO
  27443   "RTN","IBC EOB0",159, 0)
  27444    ; IB0 = t he record  being proc essed
  27445   "RTN","IBC EOB0",160, 0)
  27446    ; IBEOB =  the ien o f the EOB  entry in f ile 361.1
  27447   "RTN","IBC EOB0",161, 0)
  27448    ; IBOK =  Returned a s 1 if rec ord filed  OK, 0 if e rror occur red
  27449   "RTN","IBC EOB0",162, 0)
  27450    ;
  27451   "RTN","IBC EOB0",163, 0)
  27452    N IBDA,LE VEL,A,Z0,C T,Z
  27453   "RTN","IBC EOB0",164, 0)
  27454    I '$G(^TM P($J,40))  D  G Q45
  27455   "RTN","IBC EOB0",165, 0)
  27456    . S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= "Service l ine adjust ment (EEOB  Record 45 ) has no m atching se rvice line "
  27457   "RTN","IBC EOB0",166, 0)
  27458    . D DET4X ^IBCEOB00( 45,IB0,.Z0 )
  27459   "RTN","IBC EOB0",167, 0)
  27460    . S CT=+$ O(^TMP(IBE GBL,$J,"") ,-1),Z=0 F   S Z=$O(Z 0(Z)) Q:'Z   S CT=CT+ 1,^TMP(IBE GBL,$J,CT) =Z0(Z)
  27461   "RTN","IBC EOB0",168, 0)
  27462    ;
  27463   "RTN","IBC EOB0",169, 0)
  27464    I $P(IB0, U,3)'="" S  $P(^TMP($ J,40),U,2) =$P(IB0,U, 3)
  27465   "RTN","IBC EOB0",170, 0)
  27466    I $P(IB0, U,3)="" S  $P(IB0,U,3 )=$P(^TMP( $J,40),U,2 )
  27467   "RTN","IBC EOB0",171, 0)
  27468    I $P(IB0, U,3)="" S  ^TMP(IBEGB L,$J,+$O(^ TMP(IBEGBL ,$J,""),-1 )+1)="Serv ice line a djustment  (EEOB Reco rd 45) is  missing it s group co de" G Q45
  27469   "RTN","IBC EOB0",172, 0)
  27470    ;
  27471   "RTN","IBC EOB0",173, 0)
  27472    S IBDA(2) =+^TMP($J, 40)
  27473   "RTN","IBC EOB0",174, 0)
  27474    S IBDA(1) =+$O(^IBM( 361.1,IBEO B,15,IBDA( 2),1,"B",$ P(IB0,U,3) ,0))
  27475   "RTN","IBC EOB0",175, 0)
  27476    ;
  27477   "RTN","IBC EOB0",176, 0)
  27478    I 'IBDA(1 ) D  ;Need s a new en try at gro up level
  27479   "RTN","IBC EOB0",177, 0)
  27480    . N X,Y,D A,DD,DO,DI C,DLAYGO
  27481   "RTN","IBC EOB0",178, 0)
  27482    . S DIC=" ^IBM(361.1 ,"_IBEOB_" ,15,"_IBDA (2)_",1,", DIC(0)="L" ,DLAYGO=36 1.1151,DA( 2)=IBEOB,D A(1)=IBDA( 2)
  27483   "RTN","IBC EOB0",179, 0)
  27484    . S DIC(" P")=$$GETS PEC^IBEFUN C(361.115, 1)
  27485   "RTN","IBC EOB0",180, 0)
  27486    . S X=$P( IB0,U,3)
  27487   "RTN","IBC EOB0",181, 0)
  27488    . D FILE^ DICN K DIC ,DO,DD,DLA YGO
  27489   "RTN","IBC EOB0",182, 0)
  27490    . I Y<0 K  IBDA S ^T MP(IBEGBL, $J,+$O(^TM P(IBEGBL,$ J,""),-1)+ 1)="Could  not add ad justment g roup code  ("_$P(IB0, U,3)_") at  line adju stment "_+ ^TMP($J,40 ) Q
  27491   "RTN","IBC EOB0",183, 0)
  27492    . S IBDA( 1)=+Y
  27493   "RTN","IBC EOB0",184, 0)
  27494    ;
  27495   "RTN","IBC EOB0",185, 0)
  27496    ;Add a ne w entry at  the reaso n code lev el
  27497   "RTN","IBC EOB0",186, 0)
  27498    I $G(IBDA (1)) D
  27499   "RTN","IBC EOB0",187, 0)
  27500    . S DIC=" ^IBM(361.1 ,"_IBEOB_" ,15,"_IBDA (2)_",1,"_ IBDA(1)_", 1,",DIC(0) ="L",DLAYG O=361.1151 1,DA(1)=IB DA(1),DA(2 )=IBDA(2), DA(3)=IBEO B
  27501   "RTN","IBC EOB0",188, 0)
  27502    . S DIC(" P")=$$GETS PEC^IBEFUN C(361.1151 ,1)
  27503   "RTN","IBC EOB0",189, 0)
  27504    . S X=$P( IB0,U,4)
  27505   "RTN","IBC EOB0",190, 0)
  27506    . D FILE^ DICN K DIC ,DO,DD,DLA YGO
  27507   "RTN","IBC EOB0",191, 0)
  27508    . I Y<0 K  IBDA S ^T MP(IBEGBL, $J,+$O(^TM P(IBEGBL,$ J,""),-1)+ 1)="Could  not add re ason code  ("_$P(IB0, U,4)_") fo r adjustme nt group c ode ("_$P( IB0,U,3)_" ) at line  adjustment  "_+^TMP($ J,40) Q
  27509   "RTN","IBC EOB0",192, 0)
  27510    . S IBDA= +Y
  27511   "RTN","IBC EOB0",193, 0)
  27512    ;
  27513   "RTN","IBC EOB0",194, 0)
  27514    I $G(IBDA ) D
  27515   "RTN","IBC EOB0",195, 0)
  27516    . S LEVEL =15,LEVEL( "DIE")="^I BM(361.1," _IBEOB_",1 5,"_IBDA(2 )_",1,"_IB DA(1)_",1, "
  27517   "RTN","IBC EOB0",196, 0)
  27518    . S LEVEL (0)=IBDA,L EVEL(1)=IB DA(1),LEVE L(2)=IBDA( 2),LEVEL(3 )=IBEOB
  27519   "RTN","IBC EOB0",197, 0)
  27520    . S A="5; .02;1;0;0^ 6;.03;0;1; 1^7;.04;0; 1;0"
  27521   "RTN","IBC EOB0",198, 0)
  27522    . S IBOK= $$STORE^IB CEOB1(A,IB 0,IBEOB,.L EVEL)
  27523   "RTN","IBC EOB0",199, 0)
  27524    . I 'IBOK  S ^TMP(IB EGBL,$J,+$ O(^TMP(IBE GBL,$J,"") ,-1)+1)="M ismatched  data for r eason code  ("_$P(IB0 ,U,4)_"),  adjustment  group cod e ("_$P(IB 0,U,3)_")  at line ad justment " _+^TMP($J, 40) Q
  27525   "RTN","IBC EOB0",200, 0)
  27526    ;
  27527   "RTN","IBC EOB0",201, 0)
  27528   Q45 Q
  27529   "RTN","IBC EOB0",202, 0)
  27530    ;
  27531   "RTN","IBC EOB0",203, 0)
  27532   46(IB0,IBE OB,IBOK) ;  Process r ecord type  46 for EO
  27533   "RTN","IBC EOB0",204, 0)
  27534    ; IB0 = t he record  being proc essed
  27535   "RTN","IBC EOB0",205, 0)
  27536    ; IBEOB =  the ien o f the EOB  entry in f ile 361.1
  27537   "RTN","IBC EOB0",206, 0)
  27538    ; IBOK =  Returned a s 1 if rec ord filed  OK, 0 if e rror occur red
  27539   "RTN","IBC EOB0",207, 0)
  27540    ;
  27541   "RTN","IBC EOB0",208, 0)
  27542    S IBOK=0
  27543   "RTN","IBC EOB0",209, 0)
  27544    N AGC,IBD A,LEVEL,A, Z0,CT,Z
  27545   "RTN","IBC EOB0",210, 0)
  27546    I '$G(^TM P($J,40))  D  G Q46
  27547   "RTN","IBC EOB0",211, 0)
  27548    . S ^TMP( IBEGBL,$J, +$O(^TMP(I BEGBL,$J," "),-1)+1)= "Service l ine adjust ment (EEOB  Record 46 ) has no m atching se rvice line "
  27549   "RTN","IBC EOB0",212, 0)
  27550    . D DET4X ^IBCEOB00( 46,IB0,.Z0 )
  27551   "RTN","IBC EOB0",213, 0)
  27552    . ;S CT=+ $O(^TMP(IB EGBL,$J,"" ),-1),Z=0  F  S Z=$O( Z0(Z)) Q:' Z  S CT=CT +1,^TMP(IB EGBL,$J,CT )=Z0(Z)
  27553   "RTN","IBC EOB0",214, 0)
  27554    ;
  27555   "RTN","IBC EOB0",215, 0)
  27556    S AGC=$P( ^TMP($J,40 ),U,2)
  27557   "RTN","IBC EOB0",216, 0)
  27558    I AGC=""  S ^TMP(IBE GBL,$J,+$O (^TMP(IBEG BL,$J,""), -1)+1)="Se rvice line  adjustmen t (EEOB Re cord 46) i s missing  its group  code" G Q4 6
  27559   "RTN","IBC EOB0",217, 0)
  27560    ;
  27561   "RTN","IBC EOB0",218, 0)
  27562    S IBDA(2) =+^TMP($J, 40)
  27563   "RTN","IBC EOB0",219, 0)
  27564    S IBDA(1) =+$O(^IBM( 361.1,IBEO B,15,IBDA( 2),1,"B",A GC,0))
  27565   "RTN","IBC EOB0",220, 0)
  27566    ;
  27567   "RTN","IBC EOB0",221, 0)
  27568    ;
  27569   "RTN","IBC EOB0",222, 0)
  27570    ;Add a ne w entry at  the Payer  Policy le vel
  27571   "RTN","IBC EOB0",223, 0)
  27572    I $G(IBDA (1)) D
  27573   "RTN","IBC EOB0",224, 0)
  27574    . S DIC=" ^IBM(361.1 ,"_IBEOB_" ,15,"_IBDA (2)_",1,"_ IBDA(1)_", 2,",DIC(0) ="L",DLAYG O=361.1151 1,DA(1)=IB DA(1),DA(2 )=IBDA(2), DA(3)=IBEO B
  27575   "RTN","IBC EOB0",225, 0)
  27576    . S DIC(" P")=$$GETS PEC^IBEFUN C(361.1151 ,1)
  27577   "RTN","IBC EOB0",226, 0)
  27578    . S X=$P( IB0,U,3)
  27579   "RTN","IBC EOB0",227, 0)
  27580    . D FILE^ DICN K DIC ,DO,DD,DLA YGO
  27581   "RTN","IBC EOB0",228, 0)
  27582    . I Y<0 K  IBDA S ^T MP(IBEGBL, $J,+$O(^TM P(IBEGBL,$ J,""),-1)+ 1)="Could  not add pa yer policy  ("_$P(IB0 ,U,4)_") f or adjustm ent group  code ("_$P (IB0,U,3)_ ") at line  adjustmen t "_+^TMP( $J,40) Q
  27583   "RTN","IBC EOB0",229, 0)
  27584    . S IBDA= +Y,IBOK=1
  27585   "RTN","IBC EOB0",230, 0)
  27586    ;
  27587   "RTN","IBC EOB0",231, 0)
  27588   Q46 Q
  27589   "RTN","IBC EOB0",232, 0)
  27590    ;
  27591   "RTN","IBC EOB0",233, 0)
  27592    ; IB*2.0* 633 - Begi n modified  code bloc k
  27593   "RTN","IBC EOB0",234, 0)
  27594   ERRTXT(X,I BEOB) ; Se t error te xt based o n circumst ances
  27595   "RTN","IBC EOB0",235, 0)
  27596    ; Input -  X = Stand ard Error  message pa ssed in
  27597   "RTN","IBC EOB0",236, 0)
  27598    ;          IB0 
  27599   "RTN","IBC EOB0",237, 0)
  27600    ; Returns  modified  error mess age text
  27601   "RTN","IBC EOB0",238, 0)
  27602    N RETURN
  27603   "RTN","IBC EOB0",239, 0)
  27604    S RETURN= "Mismatche d "_X_":"
  27605   "RTN","IBC EOB0",240, 0)
  27606    I '$$EBIL L(IBEOB) S  RETURN="C laim was n ot Billed  Electronic ally:"
  27607   "RTN","IBC EOB0",241, 0)
  27608    Q RETURN
  27609   "RTN","IBC EOB0",242, 0)
  27610    ;
  27611   "RTN","IBC EOB0",243, 0)
  27612   EBILL(IBEO B) ; Check  If EOB wa s billed e lectronica lly
  27613   "RTN","IBC EOB0",244, 0)
  27614    ; Input :  IBEOB = I nternal en try number  from file  361.1
  27615   "RTN","IBC EOB0",245, 0)
  27616    ; Returns  : 1 - Bil led electr onically
  27617   "RTN","IBC EOB0",246, 0)
  27618    ;            0 - Not  billed el ectronical ly
  27619   "RTN","IBC EOB0",247, 0)
  27620    N IEN399, IEN364,STA TUS
  27621   "RTN","IBC EOB0",248, 0)
  27622    S IEN399= $$GET1^DIQ (361.1,IBE OB_",",.01 ,"I")
  27623   "RTN","IBC EOB0",249, 0)
  27624    S IEN364= $O(^IBA(36 4,"B",+IEN 399,0))
  27625   "RTN","IBC EOB0",250, 0)
  27626    I 'IEN364  Q 0 ; No  EDI TRANSM IT BILL
  27627   "RTN","IBC EOB0",251, 0)
  27628    ;
  27629   "RTN","IBC EOB0",252, 0)
  27630    S STATUS= $$GET1^DIQ (364,IEN36 4,.03,"I")
  27631   "RTN","IBC EOB0",253, 0)
  27632    I STATUS= "E"!(STATU S="C") Q 0  ; Error o r canceled
  27633   "RTN","IBC EOB0",254, 0)
  27634    Q 1
  27635   "RTN","IBC EOB0",255, 0)
  27636    ; IB*2.0* 633 - End  modified c ode block
  27637   "RTN","IBJ TEP")
  27638   0^2^B17052 1408
  27639   "RTN","IBJ TEP",1,0)
  27640   IBJTEP ;AL B/TJB - TP  ERA/835 I NFORMATION  SCREEN ;0 1-MAY-2015
  27641   "RTN","IBJ TEP",2,0)
  27642    ;;2.0;INT EGRATED BI LLING;**53 0,609,633* *;21-MAR-9 4;Build 15
  27643   "RTN","IBJ TEP",3,0)
  27644    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  27645   "RTN","IBJ TEP",4,0)
  27646    ;; ;
  27647   "RTN","IBJ TEP",5,0)
  27648   EN ; -- ma in entry p oint for I BJT ERA 83 5 INFORMAT ION
  27649   "RTN","IBJ TEP",6,0)
  27650    D EN^VALM ("IBJT ERA  835 INFOR MATION")
  27651   "RTN","IBJ TEP",7,0)
  27652    Q
  27653   "RTN","IBJ TEP",8,0)
  27654    ;
  27655   "RTN","IBJ TEP",9,0)
  27656   HDR ; -- h eader code
  27657   "RTN","IBJ TEP",10,0)
  27658    N IBRP,IB REJ S IBRP (U)=", "
  27659   "RTN","IBJ TEP",11,0)
  27660    ; Add the  EEOB, Rej ect and EC ME indicat ors to the  Bill
  27661   "RTN","IBJ TEP",12,0)
  27662    S IBREJ=$ S($$BILLRE J^IBJTU6(E PBILL):"c" ,1:"")
  27663   "RTN","IBJ TEP",13,0)
  27664    S VALMHDR (1)=$$EEOB ^IBJTLA1(I BIFN)_IBRE J_EPBILL_$ $ECME^IBTR E(IBIFN)_"   "_$E(EPN M,1,20)_"   "_EPSS_"  DOB: "_EPD OB_"  Subs c ID: "_EP SID
  27665   "RTN","IBJ TEP",14,0)
  27666    S VALMHDR (2)="Svc D ate: "_EPD OS_"  Orig  Amt: "_EP AMT_"  ERA #: "_$$REP LACE^XLFST R(ERALST,. IBRP)
  27667   "RTN","IBJ TEP",15,0)
  27668    Q
  27669   "RTN","IBJ TEP",16,0)
  27670    ;
  27671   "RTN","IBJ TEP",17,0)
  27672   INIT ; --  init varia bles and l ist array
  27673   "RTN","IBJ TEP",18,0)
  27674    N AQ,EPIE N,EPTN,ERA DA,ERAIEN, EPARR,EPPC T,EOBCT,EO BLST,EOBMX ,FL,IBAR,I BI,IBCOL,I BEBERA,IBR X,IBSHEOB, IBSPEOB ;  IB*2.0*633
  27675   "RTN","IBJ TEP",19,0)
  27676    N II,LINE ,QQ,RCBAMT ,RCCOPY,RC RC,RCOIN,R CDED,RCERR ,RCFLD,RMI EN,RCRDC,R CRLN,RCXY, RCMD,REMOV ED,X,XX,Z
  27677   "RTN","IBJ TEP",20,0)
  27678    S EOBMX=0
  27679   "RTN","IBJ TEP",21,0)
  27680    S ERALST= "",$P(SP80 ," ",80)="  "
  27681   "RTN","IBJ TEP",22,0)
  27682    ; IBIFN c omes in fr om the TPJ I screen a nd will be  cleaned u p there
  27683   "RTN","IBJ TEP",23,0)
  27684    I '$G(IBI FN) S VALM QUIT="" G  INITQ
  27685   "RTN","IBJ TEP",24,0)
  27686    K EPARR D  BILL^IBRF N3(IBIFN,. EPARR) ; G et Bill in formation
  27687   "RTN","IBJ TEP",25,0)
  27688    S EPBILL= EPARR("BN" ) ; K-Bill
  27689   "RTN","IBJ TEP",26,0)
  27690    S EPPAT=$ $GET1^DIQ( 399,IBIFN_ ",",.02,"I ") ; Get P atient IEN  
  27691   "RTN","IBJ TEP",27,0)
  27692    S EPNM=$$ GET1^DIQ(3 99,IBIFN_" ,",.02) ;  Get Patien t Name
  27693   "RTN","IBJ TEP",28,0)
  27694    ; Get Tot al Charges  and justi fy the amo unt
  27695   "RTN","IBJ TEP",29,0)
  27696    S EPAMT=$ J(+EPARR(" TCG"),$L(+ EPARR("TCG ")),2)
  27697   "RTN","IBJ TEP",30,0)
  27698    S EPSS=$E (EPNM)_$$G ET1^DIQ(2, EPPAT_",", .364) ; Ge t Short SS N
  27699   "RTN","IBJ TEP",31,0)
  27700    S EPDOB=$ $GET1^DIQ( 2,EPPAT_", ",.03) ; G et DOB
  27701   "RTN","IBJ TEP",32,0)
  27702    S EPSID=$ P(EPARR("P IN"),U,6)  ; Get Subs criber ID
  27703   "RTN","IBJ TEP",33,0)
  27704    S EPDOS=$ $FMTE^XLFD T(EPARR("S TF"),"5DZ" ) ; Get Da te of Serv ice
  27705   "RTN","IBJ TEP",34,0)
  27706    S:EPARR(" STF")'=EPA RR("STT")  EPDOS=EPDO S_" - "_$$ FMTE^XLFDT (EPARR("ST T"),"5DZ")  ; If Bill  for date  range
  27707   "RTN","IBJ TEP",35,0)
  27708    ; Check t o see if w e may have  an EEOB i f not repo rt no ERA  Informatio n for this  K-Bill
  27709   "RTN","IBJ TEP",36,0)
  27710    S EPIEN=$ O(^IBM(361 .1,"B",$G( IBIFN),"") ) I EPIEN= "" S VALMC NT=2 D SET ^VALM10(1, " "),SET^V ALM10(2,"N o ERA Info rmation fo r Bill: "_ EPBILL) G  INITQ
  27711   "RTN","IBJ TEP",37,0)
  27712    ; Get % C ollected f rom AR cla im - IA 14 52 - IB*2. 0*609
  27713   "RTN","IBJ TEP",38,0)
  27714    S IBAR=$$ BILL^RCJIB FN2(IBIFN) ,IBCOL=$P( IBAR,U,5)
  27715   "RTN","IBJ TEP",39,0)
  27716    ; Collect  all possi ble EOBs a ssociated  with this  Claim
  27717   "RTN","IBJ TEP",40,0)
  27718    S ERAIEN= ""
  27719   "RTN","IBJ TEP",41,0)
  27720    ; IB*2.0* 633 - Star t modified  block
  27721   "RTN","IBJ TEP",42,0)
  27722    S IBSHEOB =0,IBI=0,R CCOPY=0
  27723   "RTN","IBJ TEP",43,0)
  27724    F  S IBI= $O(^IBM(36 1.1,"B",IB IFN,IBI))  Q:'IBI  D   ;
  27725   "RTN","IBJ TEP",44,0)
  27726    . S IBSHE OB=IBSHEOB +1,IBSHEOB (IBI)=0
  27727   "RTN","IBJ TEP",45,0)
  27728    . ; For e ach EOB ge t the asso ciated ERA s from ADE T index
  27729   "RTN","IBJ TEP",46,0)
  27730    . S ERAIE N="" F  S  ERAIEN=$O( ^RCY(344.4 ,"ADET",IB I,ERAIEN))  Q:'ERAIEN   D  ;
  27731   "RTN","IBJ TEP",47,0)
  27732    . . S IBS HEOB(IBI,E RAIEN)=""
  27733   "RTN","IBJ TEP",48,0)
  27734    . ; PRCA* 4.5*332 -  Start modi fied code  block
  27735   "RTN","IBJ TEP",49,0)
  27736    . I $O(IB SHEOB(IBI, ""))="" D   ; EOB not  assocated  with an E RA. Check  if it was  copied.
  27737   "RTN","IBJ TEP",50,0)
  27738    . . I $$G ET1^DIQ(36 1.1,IBI_", ",.17,"I")  Q  ; Igno re manuall y entered  EOB
  27739   "RTN","IBJ TEP",51,0)
  27740    . . S X=$ O(^IBM(361 .1,IBI,101 ,"A"),-1)
  27741   "RTN","IBJ TEP",52,0)
  27742    . . I X,$ $GET1^DIQ( 361.1101,X _","_IBI_" ,",.05,"I" )="C" D  ;  EOB is a  copy
  27743   "RTN","IBJ TEP",53,0)
  27744    . . . S R CCOPY=RCCO PY+1
  27745   "RTN","IBJ TEP",54,0)
  27746    . . . S R CCOPY(RCCO PY)=IBI
  27747   "RTN","IBJ TEP",55,0)
  27748    ; IB*2.0* 633 - End  modified b lock
  27749   "RTN","IBJ TEP",56,0)
  27750    ; Loop on  the IEN f or the EEO Bs - exclu de MRAs, b ut include  all insur ances 
  27751   "RTN","IBJ TEP",57,0)
  27752    S EPIEN=" ",LINE=0,E OBCT=0
  27753   "RTN","IBJ TEP",58,0)
  27754    F  S EPIE N=$O(IBSHE OB(EPIEN))  Q:EPIEN=" "  S ERADA ="" F  S E RADA=$O(IB SHEOB(EPIE N,ERADA))  Q:'ERADA   D  ; IB*2. 0*633
  27755   "RTN","IBJ TEP",59,0)
  27756    . Q:$P($G (^IBM(361. 1,EPIEN,0) ),U,4)=1   ; Get next  because t his is an  MRA
  27757   "RTN","IBJ TEP",60,0)
  27758    . S EPTN= $$GET1^DIQ (361.1,EPI EN_",",.07 ),ERAIEN=E RADA_"," ;  IB*2.0*63 3
  27759   "RTN","IBJ TEP",61,0)
  27760    . Q:U_ERA LST_U[(U_E RAIEN_U)   ; Quit if  we have al ready repo rted this  ERA #
  27761   "RTN","IBJ TEP",62,0)
  27762    . K IBEPA R,IBPLB
  27763   "RTN","IBJ TEP",63,0)
  27764    . D GETS^ DIQ(344.4, ERAIEN,".0 1;.02;.03; .04;.05;.0 6;.07;.08; .09;.1;.11 ;.12;.13;. 14;.15;4.0 2;","E","I BEPAR")
  27765   "RTN","IBJ TEP",64,0)
  27766    . D GETS^ DIQ(344.4, ERAIEN,"2* ;","E","IB PLB") ; ER A Level Ad justments
  27767   "RTN","IBJ TEP",65,0)
  27768    . Q:$D(IB EPAR)'>0   ; No IBEPA R - no dat a done wit h this rec ord.
  27769   "RTN","IBJ TEP",66,0)
  27770    . S ERALS T=$$PUSH(E RALST,ERAI EN) S XLN= "ERA#: "_$ G(IBEPAR(" 344.4",ERA IEN,".01", "E")),XSP= $E(SP80,1, (22-$L(XLN )))
  27771   "RTN","IBJ TEP",67,0)
  27772    . S EPPCT =$S($G(EPA RR("TCG")) >0:($G(IBE PAR("344.4 ",ERAIEN," .05","E")) /EPARR("TC G"))*100,1 :0)
  27773   "RTN","IBJ TEP",68,0)
  27774    . D SET(. LINE,"** E RA SUMMARY  DATA ** " )
  27775   "RTN","IBJ TEP",69,0)
  27776    . D SET(. LINE,XLN_X SP_"TRACE# : "_$G(IBE PAR("344.4 ",ERAIEN," .02","E")) )
  27777   "RTN","IBJ TEP",70,0)
  27778    . ; Holdi ng onto th e line bel ow because  the chang e of calcu lation 
  27779   "RTN","IBJ TEP",71,0)
  27780    . ; S XLN ="ERA DATE  (PAYER):  "_$G(IBEPA R("344.4", ERAIEN,".0 4","E"))_"      TOTAL  AMT PD: " _$J($G(IBE PAR("344.4 ",ERAIEN," .05","E")) ,9)_"   %  COLLECTED:  "_$J(EPPC T,6,2)
  27781   "RTN","IBJ TEP",72,0)
  27782    . S XLN=" ERA DATE ( PAYER): "_ $G(IBEPAR( "344.4",ER AIEN,".04" ,"E"))_"                   TOTAL  AMT PD: " _$J($G(IBE PAR("344.4 ",ERAIEN," .05","E")) ,9)
  27783   "RTN","IBJ TEP",73,0)
  27784    . D SET(. LINE,XLN)
  27785   "RTN","IBJ TEP",74,0)
  27786    . D SET(. LINE,"PAYE R NAME/TIN : "_$G(IBE PAR("344.4 ",ERAIEN," .06","E")) _"/"_$G(IB EPAR("344. 4",ERAIEN, ".03","E") ))
  27787   "RTN","IBJ TEP",75,0)
  27788    . D SET(. LINE,"FILE  DATE/TIME : "_$G(IBE PAR("344.4 ",ERAIEN," .07","E")) )
  27789   "RTN","IBJ TEP",76,0)
  27790    . D SET(. LINE,"EFT  MATCH STAT US: "_$G(I BEPAR("344 .4",ERAIEN ,".09","E" )))
  27791   "RTN","IBJ TEP",77,0)
  27792    . S XLN=" ERA TYPE:  "_$G(IBEPA R("344.4", ERAIEN,".1 ","E")),XS P=$E(SP80, 1,(40-$L(X LN)))
  27793   "RTN","IBJ TEP",78,0)
  27794    . D SET(. LINE,XLN_X SP_"INDIVI DUAL EOB C OUNT: "_$G (IBEPAR("3 44.4",ERAI EN,".11"," E")))
  27795   "RTN","IBJ TEP",79,0)
  27796    . S XLN=" MAIL MESSA GE: "_$G(I BEPAR("344 .4",ERAIEN ,".12","E" )),XSP=$E( SP80,1,(40 -$L(XLN)))
  27797   "RTN","IBJ TEP",80,0)
  27798    . D SET(. LINE,XLN_X SP_"CHECK# : "_$G(IBE PAR("344.4 ",ERAIEN," .13","E")) )
  27799   "RTN","IBJ TEP",81,0)
  27800    . S XLN=" DETAIL POS T STATUS:  "_$G(IBEPA R("344.4", ERAIEN,".1 4","E")),X SP=$E(SP80 ,1,(40-$L( XLN)))
  27801   "RTN","IBJ TEP",82,0)
  27802    . D SET(. LINE,XLN_X SP_"EXPECT ED PAYMENT  METHOD CO DE: "_$G(I BEPAR("344 .4",ERAIEN ,".15","E" )))
  27803   "RTN","IBJ TEP",83,0)
  27804    . D SET(. LINE," ")
  27805   "RTN","IBJ TEP",84,0)
  27806    . D SET(. LINE,"**** ****** ERA  LEVEL ADJ USTMENTS * *********" )
  27807   "RTN","IBJ TEP",85,0)
  27808    . I $D(IB PLB)=0 D S ET(.LINE,"   -- NONE  --")
  27809   "RTN","IBJ TEP",86,0)
  27810    . D:$D(IB PLB)'=0  ;  If we hav e PLB Data  report it
  27811   "RTN","IBJ TEP",87,0)
  27812    .. S FL=" ",RCF=0 F   S FL=$O(I BPLB(344.4 2,FL)) Q:F L=""  D
  27813   "RTN","IBJ TEP",88,0)
  27814    ... I RCF '=0 D SET( .LINE," ")
  27815   "RTN","IBJ TEP",89,0)
  27816    ... S RCF =RCF+1
  27817   "RTN","IBJ TEP",90,0)
  27818    ... S XLN ="   ADJUS TMENT REAS ON CODE: " _IBPLB(344 .42,FL,.02 ,"E"),XSP= $E(SP80,1, (45-$L(XLN )))
  27819   "RTN","IBJ TEP",91,0)
  27820    ... I $G( IBPLB(344. 42,FL,.02, "E"))'=""  S ACT=$$FI ND1^DIC(34 5.1,,"B",I BPLB(344.4 2,FL,.02," E")),ACT=$ $GET1^DIQ( 345.1,ACT, .05)
  27821   "RTN","IBJ TEP",92,0)
  27822    ... D SET (.LINE,XLN _XSP_"ADJU STMENT AMO UNT: "_$J( IBPLB(344. 42,FL,.03, "E"),9))
  27823   "RTN","IBJ TEP",93,0)
  27824    ... D SET (.LINE,"    ADJUSTMEN T CODE TEX T: "_ACT)
  27825   "RTN","IBJ TEP",94,0)
  27826    ... D SET (.LINE,"    REFERENCE : "_IBPLB( 344.42,FL, .01,"E"))
  27827   "RTN","IBJ TEP",95,0)
  27828    . D SET(. LINE," ")
  27829   "RTN","IBJ TEP",96,0)
  27830    . K IBEBE RA S ZZEPI EN=EPIEN D  EEOB^IBJT EP1("IBEBE RA",ERAIEN ,EPBILL,1)
  27831   "RTN","IBJ TEP",97,0)
  27832    . F EOBCT =1:1:IBEBE RA D
  27833   "RTN","IBJ TEP",98,0)
  27834    .. S EPIE N=$O(IBEBE RA(EOBCT," "))
  27835   "RTN","IBJ TEP",99,0)
  27836    .. I EPIE N,'$D(EOBL ST(EPIEN))  D  ;
  27837   "RTN","IBJ TEP",100,0 )
  27838    ... D EOB DET(EPIEN, 0,EOBCT,IB EBERA,ERAI EN) ; PRCA *4.5*332
  27839   "RTN","IBJ TEP",101,0 )
  27840    ... S EOB LST(EPIEN) =""
  27841   "RTN","IBJ TEP",102,0 )
  27842    . D SET(. LINE,"==== ========== ========== ========== ========== ========== ========== ========== ======")
  27843   "RTN","IBJ TEP",103,0 )
  27844    . S EPIEN =ZZEPIEN
  27845   "RTN","IBJ TEP",104,0 )
  27846    I RCCOPY  D  ;
  27847   "RTN","IBJ TEP",105,0 )
  27848    . S (X,XX )=0 F  S X =$O(RCCOPY (X)) Q:'X   D  ; Disp lay copied  EOBs - PR CA*4.5*332
  27849   "RTN","IBJ TEP",106,0 )
  27850    . . I '$D (EOBLST(RC COPY(X)))  D  ;
  27851   "RTN","IBJ TEP",107,0 )
  27852    . . . D E OBDET(RCCO PY(X),1,X, RCCOPY,"")
  27853   "RTN","IBJ TEP",108,0 )
  27854    . . . S E OBLST(RCCO PY(X))="", XX=XX+1
  27855   "RTN","IBJ TEP",109,0 )
  27856    . I XX D  SET(.LINE, "========= ========== ========== ========== ========== ========== ========== ========== =")
  27857   "RTN","IBJ TEP",110,0 )
  27858    ; No EEOB  IEN, then  report th at No ERA  recieved f or this bi ll
  27859   "RTN","IBJ TEP",111,0 )
  27860    I LINE=0  S VALMCNT= 2 D SET^VA LM10(1," " ),SET^VALM 10(2,"No E RA Informa tion for B ill: "_EPB ILL) G INI TQ
  27861   "RTN","IBJ TEP",112,0 )
  27862    S VALMCNT =LINE
  27863   "RTN","IBJ TEP",113,0 )
  27864    ;
  27865   "RTN","IBJ TEP",114,0 )
  27866   INITQ K IB EPAR,IBPLB ,IBEOB,IBD GCR,IBGX,I BSPL,IBEER R,TT,AA,EE ,RCPL,ACT, ACNT,CC,XL N,XSP,XSP1 ,TSDT,TEDT ,TRX,TECME ,RCF,SP80, X,ZZEPIEN
  27867   "RTN","IBJ TEP",115,0 )
  27868    Q
  27869   "RTN","IBJ TEP",116,0 )
  27870    ;
  27871   "RTN","IBJ TEP",117,0 )
  27872   HELP ; --  help code
  27873   "RTN","IBJ TEP",118,0 )
  27874    S X="?" D  DISP^XQOR M1 W !!
  27875   "RTN","IBJ TEP",119,0 )
  27876    Q
  27877   "RTN","IBJ TEP",120,0 )
  27878    ;
  27879   "RTN","IBJ TEP",121,0 )
  27880   EXIT ; --  exit code
  27881   "RTN","IBJ TEP",122,0 )
  27882    K EPBILL, EPEOB,ERAL ST,EPPAT,E PNM,EPSS,E PDOB,EPDOS ,EPSID,EPA MT,EPARR
  27883   "RTN","IBJ TEP",123,0 )
  27884    D CLEAR^V ALM1,CLEAN ^VALM10
  27885   "RTN","IBJ TEP",124,0 )
  27886    Q
  27887   "RTN","IBJ TEP",125,0 )
  27888    ;
  27889   "RTN","IBJ TEP",126,0 )
  27890   EXPND ; --  expand co de
  27891   "RTN","IBJ TEP",127,0 )
  27892    Q
  27893   "RTN","IBJ TEP",128,0 )
  27894    ;
  27895   "RTN","IBJ TEP",129,0 )
  27896   PUSH(VAR,V ALUE) ;
  27897   "RTN","IBJ TEP",130,0 )
  27898    S VALUE=$ TR(VALUE," ,") ; Remo ve Commas  from strin g
  27899   "RTN","IBJ TEP",131,0 )
  27900    Q:$G(VAR) ="" VALUE  ; Empty va riable
  27901   "RTN","IBJ TEP",132,0 )
  27902    ; If this  VALUE is  on the lis t don't ad d it a sec ond time
  27903   "RTN","IBJ TEP",133,0 )
  27904    I U_VAR_U [(U_VALUE_ U) Q VAR
  27905   "RTN","IBJ TEP",134,0 )
  27906    Q VAR_U_V ALUE
  27907   "RTN","IBJ TEP",135,0 )
  27908    ;
  27909   "RTN","IBJ TEP",136,0 )
  27910    ; Get the  code modi fier descr iption
  27911   "RTN","IBJ TEP",137,0 )
  27912   MODC(MCD)  ;
  27913   "RTN","IBJ TEP",138,0 )
  27914    Q:$G(MCD) ="" "No Mo difier Cod e Descript ion"
  27915   "RTN","IBJ TEP",139,0 )
  27916    N ZZIEN,Z ZDEC
  27917   "RTN","IBJ TEP",140,0 )
  27918    S ZZIEN=$ $FIND1^DIC (81.3,,"BX ","26","", "","")
  27919   "RTN","IBJ TEP",141,0 )
  27920    S ZZDEC=$ $GET1^DIQ( 81.3,ZZIEN _",",.02)
  27921   "RTN","IBJ TEP",142,0 )
  27922    Q:ZZDEC=" " "No Modi fier Code  Descriptio n"
  27923   "RTN","IBJ TEP",143,0 )
  27924    Q ZZDEC
  27925   "RTN","IBJ TEP",144,0 )
  27926    ;
  27927   "RTN","IBJ TEP",145,0 )
  27928   SET(LINE,D ATA) ; --  set arrays
  27929   "RTN","IBJ TEP",146,0 )
  27930    ; LINE =  line numbe r passed b y referenc e
  27931   "RTN","IBJ TEP",147,0 )
  27932    ; DATA =  string to  add to dis played dat a
  27933   "RTN","IBJ TEP",148,0 )
  27934    S LINE=LI NE+1
  27935   "RTN","IBJ TEP",149,0 )
  27936    D SET^VAL M10(LINE,$ G(DATA))
  27937   "RTN","IBJ TEP",150,0 )
  27938    Q
  27939   "RTN","IBJ TEP",151,0 )
  27940    ; PRCA*4. 5*332 - Mo ve EOB dis play into  its own su broutine
  27941   "RTN","IBJ TEP",152,0 )
  27942   EOBDET(EPI EN,TYPE,EO BCT,IBEBER A,ERAIEN)  ; Add EOB  detail to  List Manag er Array
  27943   "RTN","IBJ TEP",153,0 )
  27944    ; Input:   EPIEN - I nternal en try number  to file 3 61.1
  27945   "RTN","IBJ TEP",154,0 )
  27946    ;          TYPE - 0  - EEOB ass ociated wi th an ERA,  1 - Copie d EOB crea ted by spl it/edit or  link paym ent
  27947   "RTN","IBJ TEP",155,0 )
  27948    ;          EOBCT - C ount# of t his EOB wi thin the E RA
  27949   "RTN","IBJ TEP",156,0 )
  27950    ;          IBEBERA -  Number of  EOBs for  this bill  in this ER A
  27951   "RTN","IBJ TEP",157,0 )
  27952    ;          ERAIEN -  Internal e ntry numbe r from fil e 344.4
  27953   "RTN","IBJ TEP",158,0 )
  27954    ;
  27955   "RTN","IBJ TEP",159,0 )
  27956    N IBEOB,I BGX,IBCL,I BDGCR,IBRX ,IBSPL,IBE ERR,RCTRAC E
  27957   "RTN","IBJ TEP",160,0 )
  27958    D GETS^DI Q(361.1,EP IEN_",",". 01;.02;.03 ;.04;.06;. 07;.14;1.0 1;1.02;1.0 3;1.1;1.11 ;2.03;2.04 ;3.03;3.04 ;3.05;3.06 ;3.07;102" ,"EI","IBE OB")
  27959   "RTN","IBJ TEP",161,0 )
  27960    D GETS^DI Q(361.1,EP IEN_",","1 0*;","EI", "IBGX"),RE SORT^IBJTE P1("IBGX", 361.111),R ESORT^IBJT EP1("IBGX" ,361.11) ;  Claim Lev el Adjustm ents
  27961   "RTN","IBJ TEP",162,0 )
  27962    D GETS^DI Q(361.1,EP IEN_",","1 5*;","EI", "IBCL") ;  Line Level  Adjustmen ts
  27963   "RTN","IBJ TEP",163,0 )
  27964    D GETS^DI Q(361.1,EP IEN_",","8 *;","EI"," IBSPL") ;  ERA Splits  for this  EEOB
  27965   "RTN","IBJ TEP",164,0 )
  27966    D GETS^DI Q(361.1,EP IEN_",","2 0;","","IB EERR") ; E OB Errors  if they ex ist
  27967   "RTN","IBJ TEP",165,0 )
  27968    ; Make it  easier to  walk the  data
  27969   "RTN","IBJ TEP",166,0 )
  27970    D RESORT^ IBJTEP1("I BCL",361.1 1511),RESO RT^IBJTEP1 ("IBCL",36 1.115),RES ORT^IBJTEP 1("IBCL",3 61.1151)
  27971   "RTN","IBJ TEP",167,0 )
  27972    D RESORT^ IBJTEP1("I BCL",361.1 152),RESOR T^IBJTEP1( "IBCL",361 .1154)
  27973   "RTN","IBJ TEP",168,0 )
  27974    D GETS^DI Q(399,IBEO B(361.1,EP IEN_",",.0 1,"I")_"," ,"460;","E I","IBDGCR ")
  27975   "RTN","IBJ TEP",169,0 )
  27976    S RCTRACE =$G(IBEOB( "361.1",EP IEN_",",". 07","E"))
  27977   "RTN","IBJ TEP",170,0 )
  27978    I ERAIEN= "",RCTRACE '="" S ERA IEN=$O(^RC Y(344.4,"D ",RCTRACE, ""))
  27979   "RTN","IBJ TEP",171,0 )
  27980    D SET(.LI NE,"****** **** "_$S( TYPE=0:"", 1:"COPIED  ")_"EOB/83 5 INFORMAT ION ("_EOB CT_" of "_ IBEBERA_")  ********* *")
  27981   "RTN","IBJ TEP",172,0 )
  27982    I $G(IBEO B("361.1", EPIEN_",", "102","I") ) D  Q  ;  EOB Remove d
  27983   "RTN","IBJ TEP",173,0 )
  27984    . D EOBRE M^IBJTEP1( EPIEN,.LIN E)
  27985   "RTN","IBJ TEP",174,0 )
  27986    . D SET(. LINE,"---- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ------")
  27987   "RTN","IBJ TEP",175,0 )
  27988    S XLN="   EOB Type:  "_$G(IBEOB ("361.1",E PIEN_","," .04","E")) ,XSP=$E(SP 80,1,(40-$ L(XLN)))
  27989   "RTN","IBJ TEP",176,0 )
  27990    D SET(.LI NE,XLN_XSP _"EOB Paid  Date: "_$ G(IBEOB("3 61.1",EPIE N_",",".06 ","E")))
  27991   "RTN","IBJ TEP",177,0 )
  27992    S TSDT=$$ FMTE^XLFDT ($G(IBEOB( "361.1",EP IEN_",","1 .1","I")), "2Z"),TEDT =$$FMTE^XL FDT($G(IBE OB("361.1" ,EPIEN_"," ,"1.11","I ")),"2Z"), XLN="  Svc  From Date : "_TSDT,X SP=$E(SP80 ,1,(40-$L( XLN)))
  27993   "RTN","IBJ TEP",178,0 )
  27994    D SET(.LI NE,XLN_XSP _"Svc to D ate: "_TED T)
  27995   "RTN","IBJ TEP",179,0 )
  27996    D SET(.LI NE,"          ICN: "_ $G(IBEOB(" 361.1",EPI EN_",",".1 4","E")))
  27997   "RTN","IBJ TEP",180,0 )
  27998    D SET(.LI NE,"  Paye r Name/TIN : "_$G(IBE OB("361.1" ,EPIEN_"," ,".02","E" ))_"/"_$G( IBEOB("361 .1",EPIEN_ ",",".03", "E")))
  27999   "RTN","IBJ TEP",181,0 )
  28000    I ERAIEN  D  ;
  28001   "RTN","IBJ TEP",182,0 )
  28002    . S XLN="      ERA # : "_$$GET1 ^DIQ(344.4 ,ERAIEN_", ",".01","E "),XSP=$E( SP80,1,(40 -$L(XLN)))
  28003   "RTN","IBJ TEP",183,0 )
  28004    . D SET(. LINE,XLN_X SP_"Auto-P ost Status : "_$$GET1 ^DIQ(344.4 ,ERAIEN_", ","4.02"," E"))
  28005   "RTN","IBJ TEP",184,0 )
  28006    . D SET(. LINE,"   T race #: "_ $$GET1^DIQ (344.4,ERA IEN_",",". 02","E"))
  28007   "RTN","IBJ TEP",185,0 )
  28008    E  D  ;
  28009   "RTN","IBJ TEP",186,0 )
  28010    . D SET(. LINE,"   T race #: "_ RCTRACE)
  28011   "RTN","IBJ TEP",187,0 )
  28012    S TECME=$ P($G(IBDGC R(399,IBEO B(361.1,EP IEN_",",.0 1,"I")_"," ,460,"E")) ,";",1)
  28013   "RTN","IBJ TEP",188,0 )
  28014    D GETRX^I BJTEP1(EPI EN,.IBRX)
  28015   "RTN","IBJ TEP",189,0 )
  28016    S TRX=$$G ET1^DIQ(52 ,+TECME_", ",".01")_" /"_$G(IBRX ("FILL"))_ "/"_$G(IBR X("RELEASE D STATUS") )
  28017   "RTN","IBJ TEP",190,0 )
  28018    I TECME=" " S TRX=""
  28019   "RTN","IBJ TEP",191,0 )
  28020    S XLN=" E CME #: "_T ECME,XSP=$ E(SP80,1,( 25-$L(XLN) )),XSP1=$E (SP80,1,(3 9-$L(XLN_X SP_"DOS: " _$G(IBRX(" DOS")))))
  28021   "RTN","IBJ TEP",192,0 )
  28022    D SET(.LI NE,XLN_XSP _"DOS: "_$ G(IBRX("DO S"))_XSP1_ "Rx/Fill/R elease Sta tus: "_TRX )
  28023   "RTN","IBJ TEP",193,0 )
  28024    D SET(.LI NE,"------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----")
  28025   "RTN","IBJ TEP",194,0 )
  28026    D:$D(IBSP L)>1  ; Th is EEOB wa s split di splay spli t payment  informatio n
  28027   "RTN","IBJ TEP",195,0 )
  28028    . N SPL
  28029   "RTN","IBJ TEP",196,0 )
  28030    . D SET(. LINE,"** A /R CORRECT ED PAYMENT  DATA:")
  28031   "RTN","IBJ TEP",197,0 )
  28032    . D SET(. LINE,"   T OTAL AMT P D:           "_$J(IBE OB(361.1,E PIEN_",",1 .01,"E"),9 ,2))
  28033   "RTN","IBJ TEP",198,0 )
  28034    . S SPL=" " F  S SPL =$O(IBSPL( 361.18,SPL )) Q:SPL=" "  D
  28035   "RTN","IBJ TEP",199,0 )
  28036    .. D SET( .LINE,"      "_$S(IBS PL(361.18, SPL,.03,"I ")'="":$$B N1^PRCAFN( IBSPL(361. 18,SPL,.03 ,"I"))_$J( "",8),1:"[ suspense]  "_IBSPL(36 1.18,SPL,. 01,"E"))_"   "_$J(IBS PL(361.18, SPL,.02,"E "),9,2))
  28037   "RTN","IBJ TEP",200,0 )
  28038    . D SET(. LINE," ")
  28039   "RTN","IBJ TEP",201,0 )
  28040    D SET(.LI NE,"CLAIM  LEVEL PAY  STATUS:")
  28041   "RTN","IBJ TEP",202,0 )
  28042    D SET(.LI NE,"  Tota l Submitte d Charges  :"_$J($G(I BEOB("361. 1",EPIEN_" ,","2.04", "E")),11,2 )_"  Payer  Covered A mount    : "_$J($G(IB EOB("361.1 ",EPIEN_", ","1.03"," E")),11,2) )
  28043   "RTN","IBJ TEP",203,0 )
  28044    D SET(.LI NE,"  Paye r Paid Amo unt        :"_$J($G(I BEOB("361. 1",EPIEN_" ,","1.01", "E")),11,2 )_"  MEDIC ARE Allowe d Amount : "_$J($G(IB EOB("361.1 ",EPIEN_", ","2.03"," E")),11,2) )
  28045   "RTN","IBJ TEP",204,0 )
  28046    D SET(.LI NE,"  Pati ent Respon sibility   :"_$J($G(I BEOB("361. 1",EPIEN_" ,","1.02", "E")),11,2 )_" %               C ollected : "_$J(+IBCO L,11,0)_"  %") ; IB*2 .0*609
  28047   "RTN","IBJ TEP",205,0 )
  28048    D SET(.LI NE,"------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----")
  28049   "RTN","IBJ TEP",206,0 )
  28050    D SET(.LI NE,"CLAIM  LEVEL ADJU STMENTS:")
  28051   "RTN","IBJ TEP",207,0 )
  28052    S AA="",A CNT=0 F  S  AA=$O(IBG X(361.11,A A)) Q:AA=" "  S ACNT= ACNT+1,AQ= "" D
  28053   "RTN","IBJ TEP",208,0 )
  28054    . S CC=AA  F  S CC=$ O(IBGX(361 .111,CC))  Q:$E(CC,1, $L(AA))'=A A  D
  28055   "RTN","IBJ TEP",209,0 )
  28056    .. I AQ=" " S AQ=$J( ACNT,3)_")  "
  28057   "RTN","IBJ TEP",210,0 )
  28058    .. E  S A CNT=ACNT+1 ,AQ=$J(ACN T,3)_") "
  28059   "RTN","IBJ TEP",211,0 )
  28060    .. D SET( .LINE,AQ_" ADJ. AMT:  "_$J(IBGX( 361.111,CC ,.02,"E"), 9,2)_"  AD J GROUP: " _IBGX(361. 11,AA,.01, "I")_" =>  "_IBGX(361 .11,AA,.01 ,"E"))
  28061   "RTN","IBJ TEP",212,0 )
  28062    .. S RMIE N=$$FIND1^ DIC(345,"" ,"BX",IBGX (361.111,C C,.01,"E") ,"","","RC ERR")
  28063   "RTN","IBJ TEP",213,0 )
  28064    .. I RMIE N'="" K RC ERR,RCRDC, RCFLD S RC XY=$$GET1^ DIQ(345,RM IEN_",",4, "","RCRDC" ,"RCERR")  D DLN^IBJT EP1("RCRDC ","RCFLD", 55,69)
  28065   "RTN","IBJ TEP",214,0 )
  28066    .. D SET( .LINE,"      ADJ. COD E: "_IBGX( 361.111,CC ,.01,"E")_ " => "_RCF LD(1))
  28067   "RTN","IBJ TEP",215,0 )
  28068    .. I RCFL D>1 F II=2 :1:RCFLD D  SET(.LINE ,"           "_RCFLD( II))
  28069   "RTN","IBJ TEP",216,0 )
  28070    I ACNT=0  D SET(.LIN E,"  -- No ne --")
  28071   "RTN","IBJ TEP",217,0 )
  28072    D SET(.LI NE,"CLAIM  LEVEL REMA RKS: ")
  28073   "RTN","IBJ TEP",218,0 )
  28074    S RCRC=0  F II="3.03 ","3.04"," 3.05","3.0 6","3.07"  D:IBEOB("3 61.1",EPIE N_",",II," E")'=""
  28075   "RTN","IBJ TEP",219,0 )
  28076    . ; Get I EN for thi s remark c ode - if n o IEN then  need to l ook at the  data "RM1 " to "RM5"
  28077   "RTN","IBJ TEP",220,0 )
  28078    . S RMIEN =$$FIND1^D IC(346,"", "BX",IBEOB ("361.1",E PIEN_",",I I,"E"),"", "","RCERR" )
  28079   "RTN","IBJ TEP",221,0 )
  28080    . I RMIEN '="" K RCE RR,RCRDC,R CFLD S RCX Y=$$GET1^D IQ(346,RMI EN_",",4," ","RCRDC", "RCERR") D  DLN^IBJTE P1("RCRDC" ,"RCFLD",5 7,69)
  28081   "RTN","IBJ TEP",222,0 )
  28082    . I RMIEN ="" S RCFL D=$S(II="3 .03":5.011 ,II="3.04" :5.021,II= "3.05":5.0 31,II="3.0 6":5.041,I I="3.07":5 .051,1:5.0 11) S RCRL N=$$GET1^D IQ(361.1,E PIEN_",",R CFLD)
  28083   "RTN","IBJ TEP",223,0 )
  28084    . S RCRC= RCRC+1 D S ET(.LINE,"   --- REMA RK CODE("_ RCRC_"): " _IBEOB("36 1.1",EPIEN _",",II,"E ")_" => "_ RCFLD(1))
  28085   "RTN","IBJ TEP",224,0 )
  28086    . I RCFLD >1 F II=2: 1:RCFLD D  SET(.LINE, "           "_RCFLD(I I))
  28087   "RTN","IBJ TEP",225,0 )
  28088    I RCRC=0  D SET(.LIN E,"  -- No ne --")
  28089   "RTN","IBJ TEP",226,0 )
  28090    D SET(.LI NE,"------ ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----")
  28091   "RTN","IBJ TEP",227,0 )
  28092    ; Walk th rough the  line level  informati on...
  28093   "RTN","IBJ TEP",228,0 )
  28094    D SET(.LI NE,"EEOB L INE LEVEL  ADJUSTMENT S:")
  28095   "RTN","IBJ TEP",229,0 )
  28096    K ^XTMP(" IBJTEP",$J ) M ^XTMP( "IBJTEP",$ J)=IBCL
  28097   "RTN","IBJ TEP",230,0 )
  28098    S RCPL=0, EE="" F  S  EE=$O(IBC L(361.115, EE)) Q:EE= ""  S RCPL =RCPL+1 D
  28099   "RTN","IBJ TEP",231,0 )
  28100    . S QQ=EE ,RCMD="" F   S QQ=$O( IBCL(361.1 152,QQ)) Q :$E(QQ,1,$ L(EE))'=EE   S RCMD=I BCL(361.11 52,QQ,.01, "I")
  28101   "RTN","IBJ TEP",232,0 )
  28102    . D SET(. LINE," #    SV DT  RE VCD   PROC   MOD  UNI TS   BILLE D  DEDUCT    COINS     ALLOW      PYMT")
  28103   "RTN","IBJ TEP",233,0 )
  28104    . S RCBAM T=$$BILLN^ IBJTEP1(IB EOB(361.1, EPIEN_",", .01,"I"),I BCL(361.11 5,EE,.1,"E "),IBCL(36 1.115,EE,. 04,"E"))
  28105   "RTN","IBJ TEP",234,0 )
  28106    . S RCDED =$$ADJU^IB JTEP1("DED UCT",.IBCL ,EE),RCOIN =$$ADJU^IB JTEP1("COI NS",.IBCL, EE) ; Get  Deductable  and Co-In surance am ts.
  28107   "RTN","IBJ TEP",235,0 )
  28108    . S XLN=$ J(RCPL,2,0 )_" "_$$FM TE^XLFDT(I BCL(361.11 5,EE,.16," I"),"2Z")_ " "_$$CJ^X LFSTR(IBCL (361.115,E E,.1,"E"), 5)_" "_$$C J^XLFSTR(I BCL(361.11 5,EE,.04," E"),8)_$$C J^XLFSTR(R CMD,5)_" " _$$CJ^XLFS TR(IBCL(36 1.115,EE,. 11,"E"),3)
  28109   "RTN","IBJ TEP",236,0 )
  28110    . D SET(. LINE,XLN_"  "_$J(RCBA MT,9,2)_$J (RCDED,8,2 )_$J(RCOIN ,8,2)_$J(I BCL(361.11 5,EE,.13," E"),9,2)_$ J(IBCL(361 .115,EE,.0 3,"E"),9,2 ))
  28111   "RTN","IBJ TEP",237,0 )
  28112    . D SET(. LINE," ")
  28113   "RTN","IBJ TEP",238,0 )
  28114    . D SET(. LINE,"  Pr oduct/Serv ice Descri ption:"_IB CL(361.115 ,EE,.09,"E "))
  28115   "RTN","IBJ TEP",239,0 )
  28116    . D SET(. LINE,"  Pa yer Policy  Reference :"_$G(IBCL (361.11512 ,EE,.01,"E ")))
  28117   "RTN","IBJ TEP",240,0 )
  28118    . D SET(. LINE," ")
  28119   "RTN","IBJ TEP",241,0 )
  28120    . S ACNT= 0,AA=EE F   S AA=$O(I BCL(361.11 51,AA)) Q: $E(AA,1,$L (EE))'=EE   D
  28121   "RTN","IBJ TEP",242,0 )
  28122    .. S ACNT =ACNT+1
  28123   "RTN","IBJ TEP",243,0 )
  28124    .. S CC=A A,RCRC=0 F   S CC=$O( IBCL(361.1 1511,CC))  Q:$E(CC,1, $L(AA))'=A A  D
  28125   "RTN","IBJ TEP",244,0 )
  28126    ... S RCR C=RCRC+1 D  SET(.LINE ,"  -> ADJ  AMT: "_$J (IBCL(361. 11511,CC,. 02,"E"),9, 2)_"  ADJ  GROUP: "_I BCL(361.11 51,AA,.01, "I")_" - " _IBCL(361. 1151,AA,.0 1,"E")_"   "_$$CJ^XLF STR("QTY:  "_+$G(IBCL (361.11511 ,CC,.03,"E ")),8))
  28127   "RTN","IBJ TEP",245,0 )
  28128    ... S RCX Y=$$FIND1^ DIC(345,"" ,"BX",IBCL (361.11511 ,CC,.01,"E "),"",""," RCERR")
  28129   "RTN","IBJ TEP",246,0 )
  28130    ... K RCR DC,RCERR S  RCXY=$$GE T1^DIQ(345 ,RCXY_",", 4,"","RCRD C","RCERR" )
  28131   "RTN","IBJ TEP",247,0 )
  28132    ... I $D( RCRDC)>0 K  RCFLD D D LN^IBJTEP1 ("RCRDC"," RCFLD",57, 57)
  28133   "RTN","IBJ TEP",248,0 )
  28134    ... I $D( RCRDC)=0 K  RCFLD S R CRDC(1)=IB CL(361.115 11,CC,.04, "E") D DLN ^IBJTEP1(" RCRDC","RC FLD",57,57 ) ; If no  data from  file 345 u se data fr om FMS
  28135   "RTN","IBJ TEP",249,0 )
  28136    ... D SET (.LINE,"       ADJ CO DE: "_$$CJ ^XLFSTR(IB CL(361.115 11,CC,.01, "E"),5)_"  "_RCFLD(1) )
  28137   "RTN","IBJ TEP",250,0 )
  28138    ... I RCF LD>1 F II= 2:1:RCFLD  D SET(.LIN E,"                        "_RCF LD(II))
  28139   "RTN","IBJ TEP",251,0 )
  28140    . ; Displ ay RARC Co des for th is Line It em
  28141   "RTN","IBJ TEP",252,0 )
  28142    . I $D(IB CL(361.115 4))'=0 S Q Q=EE,RCMD= "" F  S QQ =$O(IBCL(3 61.1154,QQ )) Q:$E(QQ ,1,$L(EE)) '=EE  D
  28143   "RTN","IBJ TEP",253,0 )
  28144    .. S RMIE N=$$FIND1^ DIC(346,"" ,"BX",IBCL (361.1154, QQ,.02,"E" ),"","","R CERR")
  28145   "RTN","IBJ TEP",254,0 )
  28146    .. I RMIE N'="" K RC ERR,RCRDC, RCFLD S RC XY=$$GET1^ DIQ(346,RM IEN_",",4, "","RCRDC" ,"RCERR")  D DLN^IBJT EP1("RCRDC ","RCFLD", 57,68)
  28147   "RTN","IBJ TEP",255,0 )
  28148    .. D SET( .LINE,"  - -- RARC: " _IBCL(361. 1154,QQ,.0 2,"E")_" -  "_RCFLD(1 ))
  28149   "RTN","IBJ TEP",256,0 )
  28150    .. I RCFL D>1 F II=2 :1:RCFLD D  SET(.LINE ,"           "_RCFLD( II))
  28151   "RTN","IBJ TEP",257,0 )
  28152    . D SET(. LINE," ")
  28153   "RTN","IBJ TEP",258,0 )
  28154    I ACNT=0  D SET(.LIN E,"  -- No  Line Leve l Adjustme nts --")
  28155   "RTN","IBJ TEP",259,0 )
  28156    ; If ther e are EOB  Errors add  them to t he screen 
  28157   "RTN","IBJ TEP",260,0 )
  28158    D:$D(IBEE RR(361.1,E PIEN_",",2 0))>9
  28159   "RTN","IBJ TEP",261,0 )
  28160    . D SET(. LINE," "), SET(.LINE, "EEOB MESS AGE ERRORS :")
  28161   "RTN","IBJ TEP",262,0 )
  28162    . N II S  II=0 F  S  II=$O(IBEE RR(361.1,E PIEN_",",2 0,II)) Q:( II="")!(II '=+II)  D  SET(.LINE, $G(IBEERR( 361.1,EPIE N_",",20,I I)))
  28163   "RTN","IBJ TEP",263,0 )
  28164    Q
  28165   "RTN","IBJ TEP1")
  28166   0^3^B58092 745
  28167   "RTN","IBJ TEP1",1,0)
  28168   IBJTEP1 ;A LB/TJB - T P ERA/835  INFORMATIO N SCREEN ; 01-MAY-201 5
  28169   "RTN","IBJ TEP1",2,0)
  28170    ;;2.0;INT EGRATED BI LLING;**53 0,633**;21 -MAR-94;Bu ild 15
  28171   "RTN","IBJ TEP1",3,0)
  28172    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  28173   "RTN","IBJ TEP1",4,0)
  28174    ;; ;
  28175   "RTN","IBJ TEP1",5,0)
  28176    Q
  28177   "RTN","IBJ TEP1",6,0)
  28178    ; Utility  Routine f or the IBJ TEP & IBJT PE routine s
  28179   "RTN","IBJ TEP1",7,0)
  28180   EEOB(ARRAY ,IENERA,KB ILL,SPLIT)  ; Return  all of the  EEOBs wit h this KBI LL for the  ERA IEN i n 344.4
  28181   "RTN","IBJ TEP1",8,0)
  28182    N ZZ,IBZZ ,CNT,IBI,I BDG,AA
  28183   "RTN","IBJ TEP1",9,0)
  28184    S CNT=0
  28185   "RTN","IBJ TEP1",10,0 )
  28186    D GETS^DI Q(344.4,IE NERA_","," 1*;","IE", "IBZZ")
  28187   "RTN","IBJ TEP1",11,0 )
  28188    S ZZ="" F   S ZZ=$O( IBZZ(344.4 1,ZZ)) Q:Z Z=""  D:IB ZZ(344.41, ZZ,.02,"E" )=KBILL
  28189   "RTN","IBJ TEP1",12,0 )
  28190    . Q:$P($G (^IBM(361. 1,IBZZ(344 .41,ZZ,.02 ,"I"),0)), U,4)=1  ;  Don't coun t, it is a  MRA
  28191   "RTN","IBJ TEP1",13,0 )
  28192    . S CNT=C NT+1,@ARRA Y@(CNT,IBZ Z(344.41,Z Z,.02,"I") )=1,AA(IBZ Z(344.41,Z Z,.02,"I") )=1
  28193   "RTN","IBJ TEP1",14,0 )
  28194    . ; See i f any spli ts are ass ociated wi th this KB ILL
  28195   "RTN","IBJ TEP1",15,0 )
  28196    . D:+$G(S PLIT)'=0
  28197   "RTN","IBJ TEP1",16,0 )
  28198    .. S IBI= 0,IBDG=$$F IND1^DIC(3 99,,,IBZZ( 344.41,ZZ, .02,"E")," B",)
  28199   "RTN","IBJ TEP1",17,0 )
  28200    .. I IBDG '="" F  S  IBI=$O(^IB M(361.1,"C ",IBDG,IBI )) Q:'IBI   S:$G(AA(I BI))'=1 CN T=CNT+1,@A RRAY@(CNT, IBI)=1 ; E OB has bee n reapport ioned at t he site
  28201   "RTN","IBJ TEP1",18,0 )
  28202    S @ARRAY= CNT
  28203   "RTN","IBJ TEP1",19,0 )
  28204    Q
  28205   "RTN","IBJ TEP1",20,0 )
  28206    ;
  28207   "RTN","IBJ TEP1",21,0 )
  28208    ; IEN = I EN for Fil e 399, COD E = Revenu e Code, CP T = the pr ocedure co de for thi s line
  28209   "RTN","IBJ TEP1",22,0 )
  28210    ; Return  the billed  amount fo r this lin e
  28211   "RTN","IBJ TEP1",23,0 )
  28212   BILLN(IEN, CODE,CPT)  ; Get the  line item  informatio n from the  Bill
  28213   "RTN","IBJ TEP1",24,0 )
  28214    N RCOUT,I I,RET
  28215   "RTN","IBJ TEP1",25,0 )
  28216    S RET=0
  28217   "RTN","IBJ TEP1",26,0 )
  28218    K RCOUT D  FIND^DIC( 399.042,", "_IEN_",", ".01;.02;. 03;.04;.06 ","",CODE, "","",""," ","RCOUT")
  28219   "RTN","IBJ TEP1",27,0 )
  28220    S II="" F   S II=$O( RCOUT("DIL IST","ID", II)) Q:II= ""  I RCOU T("DILIST" ,"ID",II,. 06)=CPT S  RET=RCOUT( "DILIST"," ID",II,.04 ) Q
  28221   "RTN","IBJ TEP1",28,0 )
  28222    Q RET
  28223   "RTN","IBJ TEP1",29,0 )
  28224    ;
  28225   "RTN","IBJ TEP1",30,0 )
  28226   ADJU(TYPE, ARR1,END)  ; Get the  Deduction  informatio n from the  line leve l
  28227   "RTN","IBJ TEP1",31,0 )
  28228    ; TYPE =  "DEDUCT" o r "COINS",  pass arra y by refer ence, END  - quit con dition
  28229   "RTN","IBJ TEP1",32,0 )
  28230    N RCOUT,A A,BB,RET
  28231   "RTN","IBJ TEP1",33,0 )
  28232    S RET=0
  28233   "RTN","IBJ TEP1",34,0 )
  28234    S AA=END  F  S AA=$O (ARR1(361. 1151,AA))  Q:$E(AA,1, $L(END))'= END  D:ARR 1(361.1151 ,AA,.01,"I ")="PR"
  28235   "RTN","IBJ TEP1",35,0 )
  28236    . S BB=AA  F  S BB=$ O(ARR1(361 .11511,BB) ) Q:$E(BB, 1,$L(AA))' =AA  D  Q: RET'=0
  28237   "RTN","IBJ TEP1",36,0 )
  28238    .. I TYPE ="DEDUCT"  S:ARR1(361 .11511,BB, .01,"E")=1  RET=ARR1( 361.11511, BB,.02,"E" ) ; Deduct able
  28239   "RTN","IBJ TEP1",37,0 )
  28240    .. I TYPE ="COINS" S :ARR1(361. 11511,BB,. 01,"E")=2  RET=ARR1(3 61.11511,B B,.02,"E")  ; Co-Insu rance
  28241   "RTN","IBJ TEP1",38,0 )
  28242    Q RET
  28243   "RTN","IBJ TEP1",39,0 )
  28244    ;
  28245   "RTN","IBJ TEP1",40,0 )
  28246   RESORT(ZAR ,ZIDX) ; R esort the  subscripts  from GETS  so items  collate co rrectly wh ile walkin g the arra y
  28247   "RTN","IBJ TEP1",41,0 )
  28248    ; Pass ZA R through  indirectio n
  28249   "RTN","IBJ TEP1",42,0 )
  28250    ; Take th e second s ubscript a nd reverse  the piece s, put the m in right  order
  28251   "RTN","IBJ TEP1",43,0 )
  28252    Q:$G(ZIDX )']""
  28253   "RTN","IBJ TEP1",44,0 )
  28254    N II,XX,Y Y,ZZ,Z1,ZN ,A S ZZ="" ,ZN=""
  28255   "RTN","IBJ TEP1",45,0 )
  28256    F  S ZZ=$ O(@ZAR@(ZI DX,ZZ)) Q: ZZ=""  D
  28257   "RTN","IBJ TEP1",46,0 )
  28258    . S ZN=""  F II=1:1: ($L(ZZ,"," )-1) S ZN= $P(ZZ,",", II)_","_ZN
  28259   "RTN","IBJ TEP1",47,0 )
  28260    . S XX=""  F  S XX=$ O(@ZAR@(ZI DX,ZZ,XX))  Q:XX=""   D
  28261   "RTN","IBJ TEP1",48,0 )
  28262    .. I $D(@ ZAR@(ZIDX, ZZ,XX,"E") )=1 S YY=@ ZAR@(ZIDX, ZZ,XX,"E")  K @ZAR@(Z IDX,ZZ,XX, "E") S QQ( ZN,XX,"E") =YY
  28263   "RTN","IBJ TEP1",49,0 )
  28264    .. I $D(@ ZAR@(ZIDX, ZZ,XX,"I") )=1 S YY=@ ZAR@(ZIDX, ZZ,XX,"I")  K @ZAR@(Z IDX,ZZ,XX, "I") S QQ( ZN,XX,"I") =YY
  28265   "RTN","IBJ TEP1",50,0 )
  28266    M @ZAR@(Z IDX)=QQ
  28267   "RTN","IBJ TEP1",51,0 )
  28268    K QQ
  28269   "RTN","IBJ TEP1",52,0 )
  28270    Q
  28271   "RTN","IBJ TEP1",53,0 )
  28272    ;
  28273   "RTN","IBJ TEP1",54,0 )
  28274   RECEIPT ;  Go to Rece ipt profil e
  28275   "RTN","IBJ TEP1",55,0 )
  28276    ; Build t he ^TMP(RC DPDPLM,$J, "IDX",#,#) =# array i f we have  a receipt  on this ER A
  28277   "RTN","IBJ TEP1",56,0 )
  28278    ; ERALST,  IBIFN is  passed in  by IBJTEP  and will b e cleaned  up there
  28279   "RTN","IBJ TEP1",57,0 )
  28280    N IBERA,I BEPB,IBRP, DIR,DTOUT, DUOUT,DZX, EPIEN,I,IX ,INDEX,X,Y ,IBARR,IBA R2,IBAR3,R CDEPTDA,RC RECTDA,RCD PFXIT
  28281   "RTN","IBJ TEP1",58,0 )
  28282    D FULL^VA LM1
  28283   "RTN","IBJ TEP1",59,0 )
  28284    S VALMBCK ="R"
  28285   "RTN","IBJ TEP1",60,0 )
  28286   RC1 ;
  28287   "RTN","IBJ TEP1",61,0 )
  28288    S IBRP(U) =", "
  28289   "RTN","IBJ TEP1",62,0 )
  28290    I $L(ERAL ST,U)=1 S  IBERA=ERAL ST G RC2
  28291   "RTN","IBJ TEP1",63,0 )
  28292    S DIR("A" )="Enter E RA for rec eipt revie w: ",DIR(0 )="FA^1:10 "
  28293   "RTN","IBJ TEP1",64,0 )
  28294    S DIR("A" ,1)="Enter  an ERA# f rom the fo llowing li st for add itional in formation. "
  28295   "RTN","IBJ TEP1",65,0 )
  28296    S DIR("A" ,2)="Avail able ERAs:  "_$$REPLA CE^XLFSTR( ERALST,.IB RP)
  28297   "RTN","IBJ TEP1",66,0 )
  28298    D ^DIR K  DIR
  28299   "RTN","IBJ TEP1",67,0 )
  28300    I $D(DTOU T)!$D(DUOU T)!(Y="")  G RCQ
  28301   "RTN","IBJ TEP1",68,0 )
  28302    S IBERA=Y  I (U_ERAL ST_U)'[(U_ Y_U) W !!, "ERA: "_Y_ " not a va lid select ion. Pleas e try agai n...",! S  X="",IBERA ="" G RC1
  28303   "RTN","IBJ TEP1",69,0 )
  28304    ;
  28305   "RTN","IBJ TEP1",70,0 )
  28306   RC2 ;
  28307   "RTN","IBJ TEP1",71,0 )
  28308    I $G(IBER A)="" S DI R("A",1)=" No ERAs fo r this K-B ill exist. ",DIR(0)=" EA",DIR("A ")="Press  ENTER to c ontinue: "  W ! D ^DI R K DIR G  RCQ
  28309   "RTN","IBJ TEP1",72,0 )
  28310    ; Get zer o node of  ERA
  28311   "RTN","IBJ TEP1",73,0 )
  28312    S ZN=$G(^ RCY(344.4, IBERA,0))
  28313   "RTN","IBJ TEP1",74,0 )
  28314    ; Get Rec iept for t his Bill
  28315   "RTN","IBJ TEP1",75,0 )
  28316    K IBEPB,^ TMP("RCDPD PLM",$J) D  GETS^DIQ( 344.4,IBER A_",","1*; ","IE","IB EPB")
  28317   "RTN","IBJ TEP1",76,0 )
  28318    ; No Rece ipt then r eport and  quit
  28319   "RTN","IBJ TEP1",77,0 )
  28320    I $P(ZN,U ,8)="",$D( ^RCY(344.4 ,IBERA,1," RECEIPT")) =0 S DIR(" A",1)="No  receipts e xist for t his ERA.", DIR(0)="EA ",DIR("A") ="Press EN TER to con tinue: " W  ! D ^DIR  K DIR G RC Q
  28321   "RTN","IBJ TEP1",78,0 )
  28322    ; Reciept , build te mp global  and call R ECEIPTS
  28323   "RTN","IBJ TEP1",79,0 )
  28324    S I=0,IX= "" F  S IX =$O(IBEPB( 344.41,IX) ) Q:IX=""   I $G(IBEP B(344.41,I X,.02,"E") )=EPBILL D
  28325   "RTN","IBJ TEP1",80,0 )
  28326    . ; Add R eciept to  list if no t already  on this li st
  28327   "RTN","IBJ TEP1",81,0 )
  28328    . I $G(IB EPB(344.41 ,IX,.25,"I "))'="" S: '$D(^TMP(" RCDPDPLM", $J,"RCPT", IBEPB(344. 41,IX,.25, "I"))) I=I +1,^TMP("R CDPDPLM",$ J,"IDX",I, I)=$G(IBEP B(344.41,I X,.25,"I") ),^TMP("RC DPDPLM",$J ,"RCPT",IB EPB(344.41 ,IX,.25,"I "))=""
  28329   "RTN","IBJ TEP1",82,0 )
  28330    ;  if no  receipts,  then set t he single  Receipt fr om the zer o node.
  28331   "RTN","IBJ TEP1",83,0 )
  28332    I '$D(^TM P("RCDPDPL M",$J,"IDX ")) S:$P(Z N,U,8)'=""  ^TMP("RCD PDPLM",$J, "IDX",1,1) =$P(ZN,U,8 ),^TMP("RC DPDPLM",$J ,"RCPT",$P (ZN,U,8))= "" I $P(ZN ,U,8)="" D   G RCQ
  28333   "RTN","IBJ TEP1",84,0 )
  28334    . S DIR(" A",1)="Iss ue with ER A: "_IBERA _" and Bil l No.: "_E PBILL,DIR( 0)="EA",DI R("A")="Pr ess ENTER  to continu e: " W ! D  ^DIR K DI R
  28335   "RTN","IBJ TEP1",85,0 )
  28336    ;
  28337   "RTN","IBJ TEP1",86,0 )
  28338    S RCRECTD A=$$GETRCP T($NA(^TMP ("RCDPDPLM ",$J,"IDX" )))
  28339   "RTN","IBJ TEP1",87,0 )
  28340    I RCRECTD A=-1 G RCQ  ; no sele ction, "^"  or read t imeout
  28341   "RTN","IBJ TEP1",88,0 )
  28342    D EN^VALM ("RCDP REC EIPT PROFI LE")
  28343   "RTN","IBJ TEP1",89,0 )
  28344    ;
  28345   "RTN","IBJ TEP1",90,0 )
  28346   RCQ ;
  28347   "RTN","IBJ TEP1",91,0 )
  28348    ; If RCDP FXIT is se t, exit op tion entir ely was se lected so  quit back  to the men u
  28349   "RTN","IBJ TEP1",92,0 )
  28350    I $G(RCDP FXIT) S VA LMBCK="Q"
  28351   "RTN","IBJ TEP1",93,0 )
  28352    K ^TMP("R CDPDPLM",$ J)
  28353   "RTN","IBJ TEP1",94,0 )
  28354    Q
  28355   "RTN","IBJ TEP1",95,0 )
  28356    ;
  28357   "RTN","IBJ TEP1",96,0 )
  28358   GETRCPT(AR RAY) ; If  only one r eceipt ret urn with t he single  receipt, o therwise u ser select s receipt
  28359   "RTN","IBJ TEP1",97,0 )
  28360    I '$O(@AR RAY@(1)) Q  $S($G(@AR RAY@(1,1)) '="":$G(@A RRAY@(1,1) ),1:-1)
  28361   "RTN","IBJ TEP1",98,0 )
  28362    N ZX,ZY,Z Z,ZAR,DIR, X,Y,DTOUT, DUOUT,DIRO UT,DIRUT,Q Q
  28363   "RTN","IBJ TEP1",99,0 )
  28364    S ZZ=0,QQ ="",ZX=""  F  S ZX=$O (@ARRAY@(Z X)) Q:ZX=" "  S:QQ'=" " QQ=QQ_"; " S ZZ=ZZ+ 1,QQ=QQ_ZZ _":"_$P($G (^RCY(344, @ARRAY@(ZX ,ZX),0)),U ,1),ZAR(ZZ )=@ARRAY@( ZX,ZX)
  28365   "RTN","IBJ TEP1",100, 0)
  28366    S DIR(0)= "S^"_QQ
  28367   "RTN","IBJ TEP1",101, 0)
  28368    S DIR("A" )="Enter i ndex numbe r for Rece ipt" D ^DI R K DIR
  28369   "RTN","IBJ TEP1",102, 0)
  28370    I $D(DTOU T)!$D(DUOU T)!(Y="")  Q -1 ; no  selection/ timeout qu it
  28371   "RTN","IBJ TEP1",103, 0)
  28372    Q ZAR(Y)
  28373   "RTN","IBJ TEP1",104, 0)
  28374    ;
  28375   "RTN","IBJ TEP1",105, 0)
  28376   GETRX(IBIE N,IBARRY)  ;return ph armacy dat a to about  EEOB item s
  28377   "RTN","IBJ TEP1",106, 0)
  28378    ;   input  -    IBIE N = ien to  record in  361.1
  28379   "RTN","IBJ TEP1",107, 0)
  28380    ;               IBAR RY = Array  name that  will be u sed to sto re and ret urn pharma cy data el ements
  28381   "RTN","IBJ TEP1",108, 0)
  28382    ;   outpu t -   IBAR RY = holds  pharmacy  data 
  28383   "RTN","IBJ TEP1",109, 0)
  28384    ; IA 6033  (controll ed subscri ption) - r ead access  of file 3 62.4.  sta tus is pen ding
  28385   "RTN","IBJ TEP1",110, 0)
  28386    ; ICR 187 8 (support ed) - usag e of EN^PS OORDER
  28387   "RTN","IBJ TEP1",111, 0)
  28388    ;
  28389   "RTN","IBJ TEP1",112, 0)
  28390    N IB0,RXD ATA,RXIEN, IBDFN,PRIE N,RXFILL
  28391   "RTN","IBJ TEP1",113, 0)
  28392    K IBARRY
  28393   "RTN","IBJ TEP1",114, 0)
  28394    Q:IBIEN=" "
  28395   "RTN","IBJ TEP1",115, 0)
  28396    S PRIEN=$ P(^IBM(361 .1,IBIEN,0 ),U,1) Q:P RIEN=""
  28397   "RTN","IBJ TEP1",116, 0)
  28398    S IBDFN=$ P(^PRCA(43 0,PRIEN,0) ,U,7)
  28399   "RTN","IBJ TEP1",117, 0)
  28400    S IB0=+$O (^IBA(362. 4,"C",PRIE N,0))
  28401   "RTN","IBJ TEP1",118, 0)
  28402    Q:IB0=0
  28403   "RTN","IBJ TEP1",119, 0)
  28404    S RXDATA= $G(^IBA(36 2.4,IB0,0) )
  28405   "RTN","IBJ TEP1",120, 0)
  28406    S IBARRY( "DOS")=$$F MTE^XLFDT( $P(RXDATA, U,3),"2Z")
  28407   "RTN","IBJ TEP1",121, 0)
  28408    S IBARRY( "FILL")=+$ P(RXDATA,U ,10)           ; rx f ill#
  28409   "RTN","IBJ TEP1",122, 0)
  28410    S RXIEN=+ $P(RXDATA, U,5)             ; RX  ien ptr f ile 52
  28411   "RTN","IBJ TEP1",123, 0)
  28412    D EN^PSOO RDER(IBDFN ,RXIEN)
  28413   "RTN","IBJ TEP1",124, 0)
  28414    S IBARRY( "RX")=$P(^ TMP("PSOR" ,$J,RXIEN, 0),U,5)
  28415   "RTN","IBJ TEP1",125, 0)
  28416    I IBARRY( "FILL")=0  S IBARRY(" RELEASED S TATUS")=$S ($P(^TMP(" PSOR",$J,R XIEN,0),U, 13)]"":"Re leased",1: "Not Relea sed")   ;  Release st atus from  Rx on the  first fill  (no refil ls)
  28417   "RTN","IBJ TEP1",126, 0)
  28418    I IBARRY( "FILL")>0  S IBARRY(" RELEASED S TATUS")=$S ($P(^TMP(" PSOR",$J,R XIEN,"REF" ,IBARRY("F ILL"),0),U ,8)]"":"Re leased",1: "Not Relea sed")  ; R elease sta tus from R x refill #
  28419   "RTN","IBJ TEP1",127, 0)
  28420    Q
  28421   "RTN","IBJ TEP1",128, 0)
  28422    ;
  28423   "RTN","IBJ TEP1",129, 0)
  28424   EOBREM(RCE OB,LINE) ;  EP from I BJTEP - Sh ow EOB rem oval detai ls if EOB  removed
  28425   "RTN","IBJ TEP1",130, 0)
  28426    ; Input:  RCEOB - In ternal ent ry number  from file  361.1
  28427   "RTN","IBJ TEP1",131, 0)
  28428    ;         LINE  - Li ne counter  for ListM an storage
  28429   "RTN","IBJ TEP1",132, 0)
  28430    ; Output:  To screen
  28431   "RTN","IBJ TEP1",133, 0)
  28432    ; Get las t move/cop y history  record
  28433   "RTN","IBJ TEP1",134, 0)
  28434    N I,J,RCE OBH,RCJUST
  28435   "RTN","IBJ TEP1",135, 0)
  28436    S RCEOBH= $O(^IBM(36 1.1,RCEOB, 101,"A"),- 1)
  28437   "RTN","IBJ TEP1",136, 0)
  28438    ; Quit if  EOB if no  history f ound - sho uld not oc cur since  EOB is rem oved
  28439   "RTN","IBJ TEP1",137, 0)
  28440    I 'RCEOBH  D SET^IBJ TEP(.LINE, "**EOB Rem oved**") Q
  28441   "RTN","IBJ TEP1",138, 0)
  28442    ;
  28443   "RTN","IBJ TEP1",139, 0)
  28444    D SET^IBJ TEP(.LINE, "EOB Remov ed by    :  "_$$GET1^ DIQ(361.11 01,RCEOBH_ ","_RCEOB, .02,"E"))
  28445   "RTN","IBJ TEP1",140, 0)
  28446    D SET^IBJ TEP(.LINE, "Date/Time  Removed :  "_$$GET1^ DIQ(361.11 01,RCEOBH_ ","_RCEOB, .01,"E"))
  28447   "RTN","IBJ TEP1",141, 0)
  28448    S RCJUST= $$GET1^DIQ (361.1101, RCEOBH_"," _RCEOB,.03 ,"E")
  28449   "RTN","IBJ TEP1",142, 0)
  28450    I $L(RCJU ST>59) D   ;
  28451   "RTN","IBJ TEP1",143, 0)
  28452    . S I=1
  28453   "RTN","IBJ TEP1",144, 0)
  28454    . F J=1:1 :$L(RCJUST ," ") D  ;
  28455   "RTN","IBJ TEP1",145, 0)
  28456    . . I $L( $G(RCJUST( I))_$P(RCJ UST," ",J) )>60 S I=I +1
  28457   "RTN","IBJ TEP1",146, 0)
  28458    . . S RCJ UST(I)=$G( RCJUST(I)) _" "_$P(RC JUST," ",J )
  28459   "RTN","IBJ TEP1",147, 0)
  28460    E  S RCJU ST(1)=RCJU ST
  28461   "RTN","IBJ TEP1",148, 0)
  28462    D SET^IBJ TEP(.LINE, "Justifica tion     : "_$G(RCJUS T(1)))
  28463   "RTN","IBJ TEP1",149, 0)
  28464    F J=2:1:I  D SET^IBJ TEP(.LINE, "                     "_$G(RCJUS T(J)))
  28465   "RTN","IBJ TEP1",150, 0)
  28466    Q
  28467   "RTN","IBJ TEP1",151, 0)
  28468    ;
  28469   "RTN","IBJ TEP1",152, 0)
  28470    ; Make CA RC or RARC  descripti on lines t he right l ength for  display -  IB*2.0*633  Moved for  routine s ize
  28471   "RTN","IBJ TEP1",153, 0)
  28472   DLN(ZIN,ZA RR,FLN,SLN ) ;
  28473   "RTN","IBJ TEP1",154, 0)
  28474    ; ZIN - a rray to ge t lines of  text
  28475   "RTN","IBJ TEP1",155, 0)
  28476    ; ZRARR -  array for  display p assed by i ndirection
  28477   "RTN","IBJ TEP1",156, 0)
  28478    ; FLN - F irst line  length; SL N - Second  and subse quent line  lengths
  28479   "RTN","IBJ TEP1",157, 0)
  28480    N ZI,ZX,Z L,ZXL,ZICT ,ZCT,ZSP,Z LN
  28481   "RTN","IBJ TEP1",158, 0)
  28482    S ZI="",Z CT=0,ZICT= 0
  28483   "RTN","IBJ TEP1",159, 0)
  28484    ; Get num ber of lin es in arra y
  28485   "RTN","IBJ TEP1",160, 0)
  28486    F  S ZI=$ O(@ZIN@(ZI )) Q:ZI=""   S ZICT=Z ICT+1
  28487   "RTN","IBJ TEP1",161, 0)
  28488    ; If more  than one  line in ar ray, proce ss the lin e
  28489   "RTN","IBJ TEP1",162, 0)
  28490    D:ZICT>1
  28491   "RTN","IBJ TEP1",163, 0)
  28492    . S ZI="" ,ZL="" F   S ZI=$O(@Z IN@(ZI)) Q :ZI=""  S  ZL=ZL_$S($ L(ZL)>1:"  ",1:"")_@Z IN@(ZI) D
  28493   "RTN","IBJ TEP1",164, 0)
  28494    .. F  Q:$ L(ZL)<SLN   S ZCT=ZCT +1 D
  28495   "RTN","IBJ TEP1",165, 0)
  28496    ... I ZCT =1 S:$L(ZL )<FLN @ZAR R@(ZCT)=ZL ,ZL="" D:$ L(ZL)>FLN   ; First l ine
  28497   "RTN","IBJ TEP1",166, 0)
  28498    .... S ZX L="" F ZX= 1:1 Q:($L( ZXL)+$L($P (ZL," ",ZX )))>FLN  S  ZXL=ZXL_$ S($L(ZXL)> 0:" ",1:"" )_$P(ZL,"  ",ZX)
  28499   "RTN","IBJ TEP1",167, 0)
  28500    .... K ZS P S @ZARR@ (ZCT)=ZXL, ZSP(ZXL)=" ",ZL=$$REP LACE^XLFST R(ZL,.ZSP) ,ZL=$$TRIM ^XLFSTR(ZL )
  28501   "RTN","IBJ TEP1",168, 0)
  28502    ... D:ZCT >1
  28503   "RTN","IBJ TEP1",169, 0)
  28504    .... S ZX L="" F ZX= 1:1 Q:($L( ZXL)+$L($P (ZL," ",ZX )))>SLN  S  ZXL=ZXL_$ S($L(ZXL)> 0:" ",1:"" )_$P(ZL,"  ",ZX)
  28505   "RTN","IBJ TEP1",170, 0)
  28506    .... K ZS P S @ZARR@ (ZCT)=ZXL, ZSP(ZXL)=" ",ZL=$$REP LACE^XLFST R(ZL,.ZSP) ,ZL=$$TRIM ^XLFSTR(ZL )
  28507   "RTN","IBJ TEP1",171, 0)
  28508    . I ($L(Z L)>1) S ZC T=ZCT+1,@Z ARR@(ZCT)= ZL,ZL=""
  28509   "RTN","IBJ TEP1",172, 0)
  28510    . S @ZARR =ZCT
  28511   "RTN","IBJ TEP1",173, 0)
  28512    ; One lin e in array  break up  if necessa ry
  28513   "RTN","IBJ TEP1",174, 0)
  28514    I ZICT=1  D
  28515   "RTN","IBJ TEP1",175, 0)
  28516    . S ZX=$O (@ZIN@("") )
  28517   "RTN","IBJ TEP1",176, 0)
  28518    . I $L(@Z IN@(ZX))<F LN S @ZARR @(1)=@ZIN@ (ZX),@ZARR =1 Q
  28519   "RTN","IBJ TEP1",177, 0)
  28520    . ; Other wise we ar e spanning  two lines
  28521   "RTN","IBJ TEP1",178, 0)
  28522    . S ZL=""  F ZI=1:1  Q:($L(ZL)+ $L($P(@ZIN @(ZX)," ", ZI)))>FLN   S ZL=ZL_$ S($L(ZL)>0 :" ",1:"") _$P(@ZIN@( ZX)," ",ZI )
  28523   "RTN","IBJ TEP1",179, 0)
  28524    . S @ZARR @(1)=ZL,@Z ARR@(2)=$P (@ZIN@(ZX) ," ",ZI,99 99)
  28525   "RTN","IBJ TEP1",180, 0)
  28526    . S @ZARR =2
  28527   "RTN","IBJ TEP1",181, 0)
  28528    Q
  28529   "VER")
  28530   8.0^22.2
  28531   **END**
  28532   **END**