2. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 11/30/2016 2:07:43 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.

2.1 Files compared

# Location File Last Modified
1 OSCIF_ROE_RRE_REE.zip ZZCIFPRCA_4_5_315_110716.KID Mon Nov 7 17:35:18 2016 UTC
2 OSCIF_ROE_RRE_REE.zip ZZCIFPRCA_4_5_315_110716.KID Wed Nov 30 16:03:48 2016 UTC

2.2 Comparison summary

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

2.3 Comparison options

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

2.4 Active regular expressions

No regular expressions were active.

2.5 Comparison detail

  1   KIDS Distr ibution sa ved on Nov  07, 2016@ 12:30:03
  2   PRCA*4.5*3 15 CIF SUB MISSION
  3   **KIDS**:Z ZCIFPRCA*4 .5*315^
  4  
  5   **INSTALL  NAME**
  6   ZZCIFPRCA* 4.5*315
  7   "BLD",1032 0,0)
  8   ZZCIFPRCA* 4.5*315^^0 ^3161107^n
  9   "BLD",1032 0,1,0)
  10   ^^1^1^3161 107^
  11   "BLD",1032 0,1,1,0)
  12   PRCA*4.5*3 15 Code in  Flight Su bmission ( HAPE Reven ue Enhance ments)
  13   "BLD",1032 0,4,0)
  14   ^9.64PA^^
  15   "BLD",1032 0,6.3)
  16   1
  17   "BLD",1032 0,"INID")
  18   ^n
  19   "BLD",1032 0,"INIT")
  20   PRCA315P
  21   "BLD",1032 0,"KRN",0)
  22   ^9.67PA^77 9.2^20
  23   "BLD",1032 0,"KRN",.4 ,0)
  24   .4
  25   "BLD",1032 0,"KRN",.4 ,"NM",0)
  26   ^9.68A^^0
  27   "BLD",1032 0,"KRN",.4 01,0)
  28   .401
  29   "BLD",1032 0,"KRN",.4 01,"NM",0)
  30   ^9.68A^^0
  31   "BLD",1032 0,"KRN",.4 02,0)
  32   .402
  33   "BLD",1032 0,"KRN",.4 03,0)
  34   .403
  35   "BLD",1032 0,"KRN",.5 ,0)
  36   .5
  37   "BLD",1032 0,"KRN",.8 4,0)
  38   .84
  39   "BLD",1032 0,"KRN",3. 6,0)
  40   3.6
  41   "BLD",1032 0,"KRN",3. 8,0)
  42   3.8
  43   "BLD",1032 0,"KRN",9. 2,0)
  44   9.2
  45   "BLD",1032 0,"KRN",9. 8,0)
  46   9.8
  47   "BLD",1032 0,"KRN",9. 8,"NM",0)
  48   ^9.68A^8^6
  49   "BLD",1032 0,"KRN",9. 8,"NM",1,0 )
  50   PRCAXP^^0^ B23479334
  51   "BLD",1032 0,"KRN",9. 8,"NM",4,0 )
  52   RCRJRCOR^^ 0^B6695057 6
  53   "BLD",1032 0,"KRN",9. 8,"NM",5,0 )
  54   RCRJRCOU^^ 0^B3116950 5
  55   "BLD",1032 0,"KRN",9. 8,"NM",6,0 )
  56   RCDPRTP^^0 ^B9630571
  57   "BLD",1032 0,"KRN",9. 8,"NM",7,0 )
  58   RCDPRTP0^^ 0^B2416214 8
  59   "BLD",1032 0,"KRN",9. 8,"NM",8,0 )
  60   RCDPRTP2^^ 0^B1792475 0
  61   "BLD",1032 0,"KRN",9. 8,"NM","B" ,"PRCAXP", 1)
  62  
  63   "BLD",1032 0,"KRN",9. 8,"NM","B" ,"RCDPRTP" ,6)
  64  
  65   "BLD",1032 0,"KRN",9. 8,"NM","B" ,"RCDPRTP0 ",7)
  66  
  67   "BLD",1032 0,"KRN",9. 8,"NM","B" ,"RCDPRTP2 ",8)
  68  
  69   "BLD",1032 0,"KRN",9. 8,"NM","B" ,"RCRJRCOR ",4)
  70  
  71   "BLD",1032 0,"KRN",9. 8,"NM","B" ,"RCRJRCOU ",5)
  72  
  73   "BLD",1032 0,"KRN",19 ,0)
  74   19
  75   "BLD",1032 0,"KRN",19 ,"NM",0)
  76   ^9.68A^1^1
  77   "BLD",1032 0,"KRN",19 ,"NM",1,0)
  78   PRCA ARDC  REPORT^^0
  79   "BLD",1032 0,"KRN",19 ,"NM","B", "PRCA ARDC  REPORT",1 )
  80  
  81   "BLD",1032 0,"KRN",19 .1,0)
  82   19.1
  83   "BLD",1032 0,"KRN",10 1,0)
  84   101
  85   "BLD",1032 0,"KRN",40 9.61,0)
  86   409.61
  87   "BLD",1032 0,"KRN",77 1,0)
  88   771
  89   "BLD",1032 0,"KRN",77 9.2,0)
  90   779.2
  91   "BLD",1032 0,"KRN",87 0,0)
  92   870
  93   "BLD",1032 0,"KRN",89 89.51,0)
  94   8989.51
  95   "BLD",1032 0,"KRN",89 89.52,0)
  96   8989.52
  97   "BLD",1032 0,"KRN",89 94,0)
  98   8994
  99   "BLD",1032 0,"KRN","B ",.4,.4)
  100  
  101   "BLD",1032 0,"KRN","B ",.401,.40 1)
  102  
  103   "BLD",1032 0,"KRN","B ",.402,.40 2)
  104  
  105   "BLD",1032 0,"KRN","B ",.403,.40 3)
  106  
  107   "BLD",1032 0,"KRN","B ",.5,.5)
  108  
  109   "BLD",1032 0,"KRN","B ",.84,.84)
  110  
  111   "BLD",1032 0,"KRN","B ",3.6,3.6)
  112  
  113   "BLD",1032 0,"KRN","B ",3.8,3.8)
  114  
  115   "BLD",1032 0,"KRN","B ",9.2,9.2)
  116  
  117   "BLD",1032 0,"KRN","B ",9.8,9.8)
  118  
  119   "BLD",1032 0,"KRN","B ",19,19)
  120  
  121   "BLD",1032 0,"KRN","B ",19.1,19. 1)
  122  
  123   "BLD",1032 0,"KRN","B ",101,101)
  124  
  125   "BLD",1032 0,"KRN","B ",409.61,4 09.61)
  126  
  127   "BLD",1032 0,"KRN","B ",771,771)
  128  
  129   "BLD",1032 0,"KRN","B ",779.2,77 9.2)
  130  
  131   "BLD",1032 0,"KRN","B ",870,870)
  132  
  133   "BLD",1032 0,"KRN","B ",8989.51, 8989.51)
  134  
  135   "BLD",1032 0,"KRN","B ",8989.52, 8989.52)
  136  
  137   "BLD",1032 0,"KRN","B ",8994,899 4)
  138  
  139   "INIT")
  140   PRCA315P
  141   "KRN",19,1 1653,-1)
  142   0^1
  143   "KRN",19,1 1653,0)
  144   PRCA ARDC  REPORT^ARD C Detail R eport^^R^^ ^^^^^^ACCO UNTS RECEI VABLE
  145   "KRN",19,1 1653,1,0)
  146   ^^2^2^3161 003^
  147   "KRN",19,1 1653,1,1,0 )
  148   This repor t was gene rated from  the month ly backgou nd proces  and genera ted 
  149   "KRN",19,1 1653,1,2,0 )
  150   a MailMan  message.   It can now  only be r an manuall y through  this optio n.
  151   "KRN",19,1 1653,10.1)
  152   ARDC Detai ls
  153   "KRN",19,1 1653,25)
  154   START^RCRJ RCOU
  155   "KRN",19,1 1653,"U")
  156   ARDC DETAI L REPORT
  157   "MBREQ")
  158   0
  159   "ORD",18,1 9)
  160   19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
  161   "ORD",18,1 9,0)
  162   OPTION
  163   "QUES","XP F1",0)
  164   Y
  165   "QUES","XP F1","??")
  166   ^D REP^XPD H
  167   "QUES","XP F1","A")
  168   Shall I wr ite over y our |FLAG|  File
  169   "QUES","XP F1","B")
  170   YES
  171   "QUES","XP F1","M")
  172   D XPF1^XPD IQ
  173   "QUES","XP F2",0)
  174   Y
  175   "QUES","XP F2","??")
  176   ^D DTA^XPD H
  177   "QUES","XP F2","A")
  178   Want my da ta |FLAG|  yours
  179   "QUES","XP F2","B")
  180   YES
  181   "QUES","XP F2","M")
  182   D XPF2^XPD IQ
  183   "QUES","XP I1",0)
  184   YO
  185   "QUES","XP I1","??")
  186   ^D INHIBIT ^XPDH
  187   "QUES","XP I1","A")
  188   Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  189   "QUES","XP I1","B")
  190   NO
  191   "QUES","XP I1","M")
  192   D XPI1^XPD IQ
  193   "QUES","XP M1",0)
  194   PO^VA(200, :EM
  195   "QUES","XP M1","??")
  196   ^D MG^XPDH
  197   "QUES","XP M1","A")
  198   Enter the  Coordinato r for Mail  Group '|F LAG|'
  199   "QUES","XP M1","B")
  200  
  201   "QUES","XP M1","M")
  202   D XPM1^XPD IQ
  203   "QUES","XP O1",0)
  204   Y
  205   "QUES","XP O1","??")
  206   ^D MENU^XP DH
  207   "QUES","XP O1","A")
  208   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  209   "QUES","XP O1","B")
  210   NO
  211   "QUES","XP O1","M")
  212   D XPO1^XPD IQ
  213   "QUES","XP Z1",0)
  214   Y
  215   "QUES","XP Z1","??")
  216   ^D OPT^XPD H
  217   "QUES","XP Z1","A")
  218   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  219   "QUES","XP Z1","B")
  220   NO
  221   "QUES","XP Z1","M")
  222   D XPZ1^XPD IQ
  223   "QUES","XP Z2",0)
  224   Y
  225   "QUES","XP Z2","??")
  226   ^D RTN^XPD H
  227   "QUES","XP Z2","A")
  228   Want to MO VE routine s to other  CPUs
  229   "QUES","XP Z2","B")
  230   NO
  231   "QUES","XP Z2","M")
  232   D XPZ2^XPD IQ
  233   "RTN")
  234   7
  235   "RTN","PRC A315P")
  236   0^^B448090 5
  237   "RTN","PRC A315P",1,0 )
  238   PRCA315P ; SLT - PRCA *4.5*315 P OST INSTAL
  239   "RTN","PRC A315P",2,0 )
  240    ;;4.5;Acc ounts Rece ivable;**3 15**;Mar 2 0, 1995;Bu ild 1
  241   "RTN","PRC A315P",3,0 )
  242    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  243   "RTN","PRC A315P",4,0 )
  244   POSTINIT ;
  245   "RTN","PRC A315P",5,0 )
  246    ;
  247   "RTN","PRC A315P",6,0 )
  248    D BMES^XP DUTL(" >>   Starting  the Post-I nitializat ion routin e ...")
  249   "RTN","PRC A315P",7,0 )
  250    ; AR CATE GORIES
  251   "RTN","PRC A315P",8,0 )
  252    D ARCAT
  253   "RTN","PRC A315P",9,0 )
  254    D MES^XPD UTL(" >>   End of the  Post-Init ialization  routine . ..")
  255   "RTN","PRC A315P",10, 0)
  256    Q
  257   "RTN","PRC A315P",11, 0)
  258    ;
  259   "RTN","PRC A315P",12, 0)
  260    ;
  261   "RTN","PRC A315P",13, 0)
  262   ARCAT    ; AR CATEGOR Y ENTRIES  (430.2)
  263   "RTN","PRC A315P",14, 0)
  264    N %,D,D0, DA,DI,DIC, DIE,DIK,DI NUM,DLAYGO ,DQ,DR,RCD ATA,RCDINU M,X,Y
  265   "RTN","PRC A315P",15, 0)
  266    D MES^XPD UTL("      -> Adding  new AR Cat egory entr ies to fil e 430.2 .. .")
  267   "RTN","PRC A315P",16, 0)
  268    ;
  269   "RTN","PRC A315P",17, 0)
  270    ;  instal l entries  in file 43 0.2
  271   "RTN","PRC A315P",18, 0)
  272    F RCDINUM =1,2 D
  273   "RTN","PRC A315P",19, 0)
  274    . S RCDAT A=$P($T(@R CDINUM),"; ",3,99)
  275   "RTN","PRC A315P",20, 0)
  276    . S (DIC, DIE)="^PRC A(430.2,", DIC(0)="L" ,DLAYGO=43 0.2
  277   "RTN","PRC A315P",21, 0)
  278    . ;
  279   "RTN","PRC A315P",22, 0)
  280    . S IBNAM E=$P(RCDAT A,";")
  281   "RTN","PRC A315P",23, 0)
  282    . ;
  283   "RTN","PRC A315P",24, 0)
  284    . I $D(^P RCA(430.2, RCDINUM,0) ) S DIK="^ PRCA(430.2 ,",DA=RCDI NUM D ^DIK
  285   "RTN","PRC A315P",25, 0)
  286    . ;
  287   "RTN","PRC A315P",26, 0)
  288    . K DD,DO  S DLAYGO= 430.2,DIC= "^PRCA(430 .2,",DIC(0 )="L",X=IB NAME D FIL E^DICN K D
  289   IC S IBDA= +Y I Y<1 K  X,Y Q
  290   "RTN","PRC A315P",27, 0)
  291    . ;
  292   "RTN","PRC A315P",28, 0)
  293    . ;  set  the fields
  294   "RTN","PRC A315P",29, 0)
  295    . S DA=RC DINUM
  296   "RTN","PRC A315P",30, 0)
  297    . S DR="1 ///"_$P(RC DATA,";",2 )_";2////0 ;"
  298   "RTN","PRC A315P",31, 0)
  299    . S DR=DR _"3///"_$P (RCDATA,"; ",6)_";"
  300   "RTN","PRC A315P",32, 0)
  301    . S DR=DR _"5///"_$P (RCDATA,"; ",5)_";"
  302   "RTN","PRC A315P",33, 0)
  303    . S DR=DR _"7////"_$ P(RCDATA," ;",4)_";"
  304   "RTN","PRC A315P",34, 0)
  305    . S DR=DR _"9///0;10 ///0;11/// 0;12///1;1 3///2;"
  306   "RTN","PRC A315P",35, 0)
  307    . ;  add  entry
  308   "RTN","PRC A315P",36, 0)
  309    . S DINUM =RCDINUM
  310   "RTN","PRC A315P",37, 0)
  311    . S X=$P( RCDATA,";" )
  312   "RTN","PRC A315P",38, 0)
  313    . D FILE^ DICN
  314   "RTN","PRC A315P",39, 0)
  315    ;
  316   "RTN","PRC A315P",40, 0)
  317    D MES^XPD UTL("New a ccounts Re ceivable c ategories  added")
  318   "RTN","PRC A315P",41, 0)
  319    ;
  320   "RTN","PRC A315P",42, 0)
  321    Q
  322   "RTN","PRC A315P",43, 0)
  323    ;
  324   "RTN","PRC A315P",44, 0)
  325    ;
  326   "RTN","PRC A315P",45, 0)
  327    ;;ACCOUNT S RECEIVAB LE CATEGOR Y FILE (#4 30.2)
  328   "RTN","PRC A315P",46, 0)
  329    ;;.01 CAT EGORY;1 AB BREVIATION ;6 CATEGOR Y NUMBER;7  RECEIVABL E CODE
  330   "RTN","PRC A315P",47, 0)
  331   46 ;;EMERG ENCY/HUMAN ITARIAN RE IMB.;HR;;1 ;T;1212
  332   "RTN","PRC A315P",48, 0)
  333   47 ;;INELI GIBLE HOSP . REIMB.;I R;;1;T;121 3
  334   "RTN","PRC AXP")
  335   0^1^B23479 334
  336   "RTN","PRC AXP",1,0)
  337   PRCAXP ;WA SH-ISC@ALT OONA,PA/TJ K-PRINT RX -COPAY EXE MPTION REP ORT ;10/23 /93  10:01
  338    AM
  339   "RTN","PRC AXP",2,0)
  340   V ;;4.5;Ac counts Rec eivable;** 315**;Mar  20, 1995;B uild 1
  341   "RTN","PRC AXP",3,0)
  342    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  343   "RTN","PRC AXP",4,0)
  344    NEW BEG,E ND,%DT,%ZI S,IOP,POP, Y,%
  345   "RTN","PRC AXP",5,0)
  346   BEG W ! D  NOW^%DTC S  %DT(0)=-% ,%DT="AEXP ",%DT("A") ="Start Da te: " D ^% DT G:Y<0 Q
  347    S BEG=Y
  348   "RTN","PRC AXP",6,0)
  349    S %DT="AE X",%DT("A" )="     En d Date: ", %DT("B")=" T" D ^%DT  G:Y<0 Q S  END=Y
  350   "RTN","PRC AXP",7,0)
  351    W !!,"You  will need  a 132 col umn printe r for this  report!", !
  352   "RTN","PRC AXP",8,0)
  353    W ! K IO( "Q") S %ZI S="MQ" D ^ %ZIS G:POP  Q
  354   "RTN","PRC AXP",9,0)
  355    I $D(IO(" Q")) S ZTR TN="DQ^PRC AXP",ZTSAV E("BEG")=" ",ZTSAVE(" END")="" D  ^%ZTLOAD 
  356   G Q
  357   "RTN","PRC AXP",10,0)
  358    U IO
  359   "RTN","PRC AXP",11,0)
  360   DQ ;ENTRY  POINT FROM  TASK MANA GER FOR PR INTING REP ORT
  361   "RTN","PRC AXP",12,0)
  362    NEW Y,TOD AY,PG,I,PR CA,PRCAHDR ,BEGPR,END PR,TRDATE, TRNO,T0,T1 ,BILL,TRAM T,OUT,PTNM
  363   ,DFN,CONTI NUE,ID,REC ,TTYPE,VA, PTOT,PGTOT ,TOT,LAST
  364   "RTN","PRC AXP",13,0)
  365   COMPUTE ;S ETS TEMPOR ARY GLOBAL  FOR PRINT ING
  366   "RTN","PRC AXP",14,0)
  367    K ^TMP($J ) S TRDATE =BEG-1,(TO T("D"),TOT ("E"),TOT( "I"))=0,U= "^"
  368   "RTN","PRC AXP",15,0)
  369    F  S TRDA TE=$O(^PRC A(433,"ACE ",TRDATE))  G PRINT:' TRDATE!($P (TRDATE,". ")>END) S 
  370   TRNO=0 D
  371   "RTN","PRC AXP",16,0)
  372    .F  S TRN O=$O(^PRCA (433,"ACE" ,TRDATE,TR NO)) Q:'TR NO  D
  373   "RTN","PRC AXP",17,0)
  374    ..S T0=$G (^PRCA(433 ,TRNO,0)), T1=$G(^(1) ) Q:T0=""
  375   "RTN","PRC AXP",18,0)
  376    ..S BLNO= $P(T0,U,2) ,TRAMT=$P( T1,U,5),TT YPE=$S($P( T1,U,2)=35 :"D",$P(T1 ,U,2)=1:"I
  377   ",1:"E"),E FDT=$P(T1, U,1)  ;*31 5 START
  378   "RTN","PRC AXP",19,0)
  379    ..;S DFN= $P(^PRCA(4 30,BLNO,0) ,U,9),BILL =$P(^(0),U )
  380   "RTN","PRC AXP",20,0)
  381    ..S P0=$G (^PRCA(430 ,BLNO,0)), DFN=$P(P0, U,9),BILL= $P(P0,U),I BN=0
  382   "RTN","PRC AXP",21,0)
  383    ..S DFN=$ P(^RCD(340 ,+DFN,0),U ) Q:'DFN!( DFN'["DPT( ")  S DFN= +DFN
  384   "RTN","PRC AXP",22,0)
  385    ..D DEM^V ADPT S PTN M=VADM(1), ID=$E(PTNM ,1)_VA("BI D") S DTH= $S(+VADM(6 ):"*",1:""
  386   ) D KVAR^V ADPT
  387   "RTN","PRC AXP",23,0)
  388    ..D FNDBI L(TRNO,TTY PE)
  389   "RTN","PRC AXP",24,0)
  390   PRINT ;PRI NT REPORT
  391   "RTN","PRC AXP",25,0)
  392    S LAST=""
  393   "RTN","PRC AXP",26,0)
  394    S Y=BEG X  ^DD("DD")  S BEGPR=Y
  395   "RTN","PRC AXP",27,0)
  396    S Y=END X  ^DD("DD")  S ENDPR=Y
  397   "RTN","PRC AXP",28,0)
  398    S Y=DT X  ^DD("DD")  S TODAY=Y, PG=0 D HEA D
  399   "RTN","PRC AXP",29,0)
  400    I '$D(^TM P($J)) W ! !,"NO EXEM PTIONS FOR  THIS TIME  PERIOD" G  Q
  401   "RTN","PRC AXP",30,0)
  402    S PTNM=""  F  S PTNM =$O(^TMP($ J,PTNM)) Q :PTNM=""!( $D(OUT))   D
  403   "RTN","PRC AXP",31,0)
  404    .S DFN=0  F  S DFN=$ O(^TMP($J, PTNM,DFN))  Q:'DFN!($ D(OUT))  S  CONTINUE= "",PTOT=0 
  405   D  I PTOT  W !,?115," ---------- ---",!,?11 5,$J(+PTOT ,13,2),!
  406   "RTN","PRC AXP",32,0)
  407    ..S BILL= "" F  S BI LL=$O(^TMP ($J,PTNM,D FN,BILL))  Q:BILL=""! ($D(OUT))   D
  408   "RTN","PRC AXP",33,0)
  409    ...S TRNO =0 F  S TR NO=$O(^TMP ($J,PTNM,D FN,BILL,TR NO)) Q:TRN O=""!($D(O UT))  D   
  410   ;*315 STAR T
  411   "RTN","PRC AXP",34,0)
  412    ....S CON TINUE=""
  413   "RTN","PRC AXP",35,0)
  414    ....S RX= 0 F  S RX= $O(^TMP($J ,PTNM,DFN, BILL,TRNO, RX)) Q:'RX !($D(OUT))   D
  415   "RTN","PRC AXP",36,0)
  416    .....S RE C=^TMP($J, PTNM,DFN,B ILL,TRNO,R X),TRAMT=$ P(REC,U,1)  W ! W:$D( CONTINUE) 
  417   $P(REC,"^" ,4),$E(PTN M,1,25),"  ",?28,$P(R EC,U,2),?3 5,BILL,?48 ,TRNO,?56, $P(REC,U,3
  418   )
  419   "RTN","PRC AXP",37,0)
  420    .....W ?6 0,$S(RX=1: "",1:$P(RE C,U,5)) W  ?70,$E($P( REC,U,6),1 ,17),?90,$ P(REC,U,7)
  421   ,?100,$P(R EC,U,8) I  $D(CONTINU E),TRNO'=L AST W ?115 ,$J(TRAMT, 13,2)
  422   "RTN","PRC AXP",38,0)
  423    .....I $D (CONTINUE) ,TRNO'=LAS T S PTOT=P TOT+TRAMT, PGTOT=+$G( PGTOT)+TRA MT,TOT($S(
  424   $P(REC,U,3 )]"":$P(RE C,U,3),1:" UNK"))=$G( TOT($S($P( REC,U,3)]" ":$P(REC,U ,3),1:"UNK
  425   ")))+REC   ;*315 END
  426   "RTN","PRC AXP",39,0)
  427    .....K CO NTINUE S L AST=TRNO D  HEAD:($Y+ 4)>IOSL
  428   "RTN","PRC AXP",40,0)
  429    G:$D(OUT)  Q
  430   "RTN","PRC AXP",41,0)
  431    W !,"* -i ndicates p atient is  deceased"
  432   "RTN","PRC AXP",42,0)
  433    D HEAD:($ Y+7)>IOSL
  434   "RTN","PRC AXP",43,0)
  435    W !!,"EXE MPTION TYP ES AND TOT ALS"
  436   "RTN","PRC AXP",44,0)
  437    W !!,"D=D ECREASE AD JUSTMENT " ,?35,$J(TO T("D"),13, 2),!,"E=IN TEREST/ADM IN EXEMPTI
  438   ON ",?35,$ J(TOT("E") ,13,2),!," I=INCREASE  ADJUSTMEN T FOR REFU ND ",?35,$ J(TOT("I")
  439   ,13,2)
  440   "RTN","PRC AXP",45,0)
  441    I $D(TOT( "UNK")) W  !,"UNK=EXE MPTION TYP E UNKNOWN" ,?35,$J(TO T("UNK"),1 3,2)
  442   "RTN","PRC AXP",46,0)
  443    W !,?35," ---------- ---",!,?35 ,$J(PGTOT, 13,2)
  444   "RTN","PRC AXP",47,0)
  445    K BEG,END ,IO("Q") ; K ^TMP($J)  
  446   "RTN","PRC AXP",48,0)
  447   Q D ^%ZISC  Q
  448   "RTN","PRC AXP",49,0)
  449    ;
  450   "RTN","PRC AXP",50,0)
  451   FNDBIL(TRN O,TTYPE) ;
  452   "RTN","PRC AXP",51,0)
  453    N FOUND,C NT,IBN,IB0 ,RR,RX,DRU G,FLDT,EDT ,EFFDT,IBA MT,IBAS,AR TRN
  454   "RTN","PRC AXP",52,0)
  455    S (IBN,FO UND,CNT,RX )=0,EDT=""
  456   "RTN","PRC AXP",53,0)
  457    F  S IBN= $O(^IB("AB IL",BILL,I BN)) Q:IBN =""  D
  458   "RTN","PRC AXP",54,0)
  459    .S IB0=^I B(IBN,0),R R=$P(IB0,U ,4),EDT=$P (IB0,U,17) ,IBAMT=$P( IB0,U,7),A RTRN=$P(IB
  460   0,U,12)
  461   "RTN","PRC AXP",55,0)
  462    .I EDT=""  S EDT=EFD T
  463   "RTN","PRC AXP",56,0)
  464    .I EDT=""  S EDT=TRD ATE
  465   "RTN","PRC AXP",57,0)
  466    .I ARTRN= TRNO S FOU ND=1 D DAT A Q
  467   "RTN","PRC AXP",58,0)
  468    .I 'FOUND ,ARTRN=""  D DATA
  469   "RTN","PRC AXP",59,0)
  470    I CNT=0,R X=0 D
  471   "RTN","PRC AXP",60,0)
  472    .I EDT=""  S EDT=EFD T
  473   "RTN","PRC AXP",61,0)
  474    .I EDT=""  S EDT=TRD ATE
  475   "RTN","PRC AXP",62,0)
  476    .S EFFDT= $$FMTE^XLF DT(EDT,"2D Z")
  477   "RTN","PRC AXP",63,0)
  478    .D SET(1)
  479   "RTN","PRC AXP",64,0)
  480    Q
  481   "RTN","PRC AXP",65,0)
  482    ;
  483   "RTN","PRC AXP",66,0)
  484   DATA ; SET  UP DATA
  485   "RTN","PRC AXP",67,0)
  486    S CNT=CNT +1
  487   "RTN","PRC AXP",68,0)
  488    S RIEN=+$ P(RR,"52:" ,2),RFL=+$ P(RR,":",3 )
  489   "RTN","PRC AXP",69,0)
  490    S DRUG=$$ FILE^IBRXU TL(RIEN,6, "E"),RX=$$ FILE^IBRXU TL(RIEN,.0 1)
  491   "RTN","PRC AXP",70,0)
  492    I RFL>0 S  FLDT=$$SU BFILE^IBRX UTL(RIEN,R FL,52,.01)
  493   "RTN","PRC AXP",71,0)
  494    I RFL=0 S  FLDT=$$FI LE^IBRXUTL (RIEN,22)
  495   "RTN","PRC AXP",72,0)
  496    S EFFDT=$ $FMTE^XLFD T(EDT,"2DZ "),FLDT=$$ FMTE^XLFDT (FLDT,"2DZ ")
  497   "RTN","PRC AXP",73,0)
  498    I $D(^TMP ($J,PTNM,D FN,BILL,TR NO,RX)) Q
  499   "RTN","PRC AXP",74,0)
  500    D SET(RX)
  501   "RTN","PRC AXP",75,0)
  502    Q
  503   "RTN","PRC AXP",76,0)
  504    ;
  505   "RTN","PRC AXP",77,0)
  506   SET(RX) ;
  507   "RTN","PRC AXP",78,0)
  508    S ^TMP($J ,PTNM,DFN, BILL,TRNO, RX)=TRAMT_ U_ID_U_TTY PE_U_DTH_U _$G(RX)_U_ $G(DRUG)_U
  509   _$G(FLDT)_ U_$G(EFFDT )_U_$G(ART RN)_U_$G(I BAS)_U_$G( IBN)  ;*31 5 END
  510   "RTN","PRC AXP",79,0)
  511    Q
  512   "RTN","PRC AXP",80,0)
  513    ;
  514   "RTN","PRC AXP",81,0)
  515   HEAD ;PRIN TS HEADING
  516   "RTN","PRC AXP",82,0)
  517    I PG,$E(I OST,1,2)[" C-" D SCR  Q:$D(OUT)
  518   "RTN","PRC AXP",83,0)
  519    W @IOF S  PG=PG+1
  520   "RTN","PRC AXP",84,0)
  521    W !!,"Pg.  "_PG,?130 -$L(TODAY) ,TODAY
  522   "RTN","PRC AXP",85,0)
  523    S PRCAHDR ="MEDICATI ON CO-PAY  EXEMPTION  REPORT",PR CA="",$P(P RCA,"*",(1 30-$L(PRCA
  524   HDR))\2)=" *",PRCAHDR =PRCA_" "_ PRCAHDR_"  "_PRCA
  525   "RTN","PRC AXP",86,0)
  526    W !,PRCAH DR,!,?53,B EGPR,"-",E NDPR
  527   "RTN","PRC AXP",87,0)
  528    W !,?35," BILL",?48, "TRAN.",?5 6,"EXP",?9 0,"FILL/", ?100,"EFFE CTIVE"  ;* 315 START
  529   "RTN","PRC AXP",88,0)
  530    W !,"PATI ENT",?28," ID",?35,"N UMBER",?48 ,"NUMBER", ?56,"TYP", ?60,"RX",? 70,"DRUG N
  531   AME",?90," REFL DT",? 102,"DATE" ,?120,"AMO UNT"  ;*31 5 END
  532   "RTN","PRC AXP",89,0)
  533    S PRCA="" ,$P(PRCA," -",132)=""  W !,PRCA
  534   "RTN","PRC AXP",90,0)
  535    S CONTINU E=""
  536   "RTN","PRC AXP",91,0)
  537    Q
  538   "RTN","PRC AXP",92,0)
  539    ;
  540   "RTN","PRC AXP",93,0)
  541   SCR ;
  542   "RTN","PRC AXP",94,0)
  543    Q:$E(IOST ,1,2)'["C- "
  544   "RTN","PRC AXP",95,0)
  545    N DIR,YY, DIRUT,DUOU T,DTOUT,DI ROUT,X,Y
  546   "RTN","PRC AXP",96,0)
  547    F YY=$Y:1 :(IOSL-2)  W !
  548   "RTN","PRC AXP",97,0)
  549    S DIR(0)= "E" D ^DIR  I $D(DIRU T)!($D(DTO UT)) S OUT =1
  550   "RTN","PRC AXP",98,0)
  551    Q
  552   "RTN","RCD PRTP")
  553   0^6^B96305 71
  554   "RTN","RCD PRTP",1,0)
  555   RCDPRTP ;A LB/LDB-CLA IMS MATCHI NG REPORT  ;1/11/01   2:03 PM
  556   "RTN","RCD PRTP",2,0)
  557    ;;4.5;Acc ounts Rece ivable;**1 51,186,315 **;Mar 20,  1995;Buil d 1
  558   "RTN","RCD PRTP",3,0)
  559    ;
  560   "RTN","RCD PRTP",4,0)
  561    ;
  562   "RTN","RCD PRTP",5,0)
  563   EN N DATEE ND,DATESTR T,DIC,DIR, DIRUT,POP, RCAN,RCBIL L,RCDEBT,R CDFN,RCPT, RCSORT,RCQ
  564   UIT,%ZIS,Z TDESC,ZTSA VE,ZTRTN,Y
  565   "RTN","RCD PRTP",6,0)
  566    W !
  567   "RTN","RCD PRTP",7,0)
  568    K DIRUT S  DIR(0)="S ^1:Patient ;2:Bill Nu mber;3:Pay ment dates ;4:Receipt  Number;5:
  569   Care Types ",DIR("A") ="Sort by"  D ^DIR K  DIR Q:$D(D IRUT)
  570   "RTN","RCD PRTP",8,0)
  571    S DIR("A" )="Sort by " D ^DIR K  DIR Q:$D( DIRUT)
  572   "RTN","RCD PRTP",9,0)
  573    S RCSORT= Y,RCQUIT=" "
  574   "RTN","RCD PRTP",10,0 )
  575    D @RCSORT  Q:RCQUIT   W !
  576   "RTN","RCD PRTP",11,0 )
  577    K DIRUT S  DIR(0)="Y ",DIR("A") ="Include  cancelled  bills",DIR ("B")="NO"  D ^DIR S 
  578   RCAN=+Y Q: $D(DIRUT)
  579   "RTN","RCD PRTP",12,0 )
  580    ;
  581   "RTN","RCD PRTP",13,0 )
  582    ;  select  device
  583   "RTN","RCD PRTP",14,0 )
  584    W !!,"Thi s report r equires 13 2 columns. ",!
  585   "RTN","RCD PRTP",15,0 )
  586    W ! S %ZI S="Q" D ^% ZIS I POP  Q
  587   "RTN","RCD PRTP",16,0 )
  588    I $D(IO(" Q")) D  D  ^%ZTLOAD K  IO("Q"),Z TSK Q
  589   "RTN","RCD PRTP",17,0 )
  590    .S ZTDESC ="Claims M atching Re port",ZTRT N="DQ^RCDP RTP"
  591   "RTN","RCD PRTP",18,0 )
  592    .S ZTSAVE ("RCSORT") =""
  593   "RTN","RCD PRTP",19,0 )
  594    .I RCSORT =1 S ZTSAV E("RCDEBT" )="",ZTSAV E("RCDFN") ="",ZTSAVE ("DATE*")= ""
  595   "RTN","RCD PRTP",20,0 )
  596    .I RCSORT =2 S ZTSAV E("RCBILL" )="",ZTSAV E("RCDFN") ="",ZTSAVE ("RCDEBT") =""
  597   "RTN","RCD PRTP",21,0 )
  598    .I RCSORT =3 S ZTSAV E("DATE*") =""
  599   "RTN","RCD PRTP",22,0 )
  600    .I RCSORT =4 S ZTSAV E("RCPT")= ""
  601   "RTN","RCD PRTP",23,0 )
  602    .I RCSORT =5 S ZTSAV E("TYPE")= ""
  603   "RTN","RCD PRTP",24,0 )
  604    .S ZTSAVE ("RCAN")=" ",ZTSAVE(" ZTREQ")="@ "
  605   "RTN","RCD PRTP",25,0 )
  606    W !!,"<*>  please wa it <*>"
  607   "RTN","RCD PRTP",26,0 )
  608    ;
  609   "RTN","RCD PRTP",27,0 )
  610   DQ ;  queu ed report  starts her e
  611   "RTN","RCD PRTP",28,0 )
  612    U IO
  613   "RTN","RCD PRTP",29,0 )
  614    K ^TMP("R CDPRTPB",$ J)
  615   "RTN","RCD PRTP",30,0 )
  616    K ^TMP("I BRBT",$J)
  617   "RTN","RCD PRTP",31,0 )
  618    K ^TMP("I BRBF",$J)
  619   "RTN","RCD PRTP",32,0 )
  620    N DAT,RCB IL,RCBIL0, RCNAM,RCPA Y,RCPAY1,R CREC,RCREC 1,RCRECTDA ,RCSSN,RCT YP
  621   "RTN","RCD PRTP",33,0 )
  622    D @($S(RC SORT=1:"PA T",RCSORT= 2:"BILL",R CSORT=3:"D ATE",RCSOR T=4:"REC", RCSORT=5:"
  623   TYPE")_"^R CDPRTP0")
  624   "RTN","RCD PRTP",34,0 )
  625    D EN^RCDP RTP1
  626   "RTN","RCD PRTP",35,0 )
  627    K DATESTR T,DATEEND, ^TMP("RCDP RTPB",$J), RCTYPE
  628   "RTN","RCD PRTP",36,0 )
  629    D ^%ZISC
  630   "RTN","RCD PRTP",37,0 )
  631    Q
  632   "RTN","RCD PRTP",38,0 )
  633    ;
  634   "RTN","RCD PRTP",39,0 )
  635    ;
  636   "RTN","RCD PRTP",40,0 )
  637   1 S DIC(0) ="QEAMZ",D IC=340,DIC ("S")="I ^ RCD(340,+Y ,0)[""DPT" "",DIC("A" )="Patient
  638    name: " D  ^DIC I Y< 0 S RCQUIT =1 Q
  639   "RTN","RCD PRTP",41,0 )
  640    S RCDEBT= +Y,RCDFN=+ $P(Y,"^",2 )
  641   "RTN","RCD PRTP",42,0 )
  642    D DATESEL ^RCRJRTRA( "Payment")
  643   "RTN","RCD PRTP",43,0 )
  644    I '$G(DAT ESTRT)!('$ G(DATEEND) ) S RCQUIT =1
  645   "RTN","RCD PRTP",44,0 )
  646    Q
  647   "RTN","RCD PRTP",45,0 )
  648    ;
  649   "RTN","RCD PRTP",46,0 )
  650   3 D DATESE L^RCRJRTRA ("Payment" )
  651   "RTN","RCD PRTP",47,0 )
  652    I '$G(DAT ESTRT)!('$ G(DATEEND) ) S RCQUIT =1
  653   "RTN","RCD PRTP",48,0 )
  654    Q
  655   "RTN","RCD PRTP",49,0 )
  656    ;
  657   "RTN","RCD PRTP",50,0 )
  658   2 N DIC,DU OUT
  659   "RTN","RCD PRTP",51,0 )
  660    K ^TMP("I BRBF",$J)
  661   "RTN","RCD PRTP",52,0 )
  662    S DIC(0)= "QEAM",DIC =430,DIC(" S")="I $P( ^(0),U,2)= 9" D ^DIC  I Y<0 S RC QUIT=1 Q
  663   "RTN","RCD PRTP",53,0 )
  664    S RCBILL= +Y,RCDFN=$ P($G(^PRCA (430,+RCBI LL,0)),"^" ,7) Q:'RCD FN
  665   "RTN","RCD PRTP",54,0 )
  666    S RCDEBT= $O(^RCD(34 0,"B",RCDF N_";DPT(", 0))
  667   "RTN","RCD PRTP",55,0 )
  668    I (RCDFN= "")!(RCDEB T="") W !, "This bill  has no ma tching fir st party b ills." G 2
  669   "RTN","RCD PRTP",56,0 )
  670    D RELBILL ^IBRFN(RCB ILL)
  671   "RTN","RCD PRTP",57,0 )
  672    I '$O(^TM P("IBRBF", $J,RCBILL, 0)) W !,"T his bill h as no matc hing first  party deb
  673   ts." K ^TM P("IBRBF", $J) G 2
  674   "RTN","RCD PRTP",58,0 )
  675    K ^TMP("I BRBF",$J)
  676   "RTN","RCD PRTP",59,0 )
  677    Q
  678   "RTN","RCD PRTP",60,0 )
  679    ;
  680   "RTN","RCD PRTP",61,0 )
  681   4 N DIC,X, Y
  682   "RTN","RCD PRTP",62,0 )
  683    S DIC(0)= "QEAM",DIC =344 D ^DI C I Y<0 S  RCQUIT=1 Q
  684   "RTN","RCD PRTP",63,0 )
  685    S RCPT=$P (Y,"^",2)
  686   "RTN","RCD PRTP",64,0 )
  687    Q
  688   "RTN","RCD PRTP",65,0 )
  689    ;
  690   "RTN","RCD PRTP",66,0 )
  691   5 ; Select  care type  - added i n patch 31 5
  692   "RTN","RCD PRTP",67,0 )
  693    D TYPEPIC ^RCDPRTP0( .RCTYPE)
  694   "RTN","RCD PRTP",68,0 )
  695    D DATESEL ^RCRJRTRA( "Payment")
  696   "RTN","RCD PRTP",69,0 )
  697    I '$G(DAT ESTRT)!('$ G(DATEEND) ) S RCQUIT =1
  698   "RTN","RCD PRTP",70,0 )
  699    Q
  700   "RTN","RCD PRTP",71,0 )
  701    ;
  702   "RTN","RCD PRTP0")
  703   0^7^B24162 148
  704   "RTN","RCD PRTP0",1,0 )
  705   RCDPRTP0 ; ALB/LDB -  CLAIMS MAT CHING REPO RT ;5/24/0 0  10:48 A M
  706   "RTN","RCD PRTP0",2,0 )
  707    ;;4.5;Acc ounts Rece ivable;**1 51,315**;M ar 20, 199 5;Build 1
  708   "RTN","RCD PRTP0",3,0 )
  709    ;
  710   "RTN","RCD PRTP0",4,0 )
  711    ;
  712   "RTN","RCD PRTP0",5,0 )
  713   PAT ;find  patient bi lls
  714   "RTN","RCD PRTP0",6,0 )
  715    S RCNAM=$ $NAM^RCFN0 1(RCDEBT)
  716   "RTN","RCD PRTP0",7,0 )
  717    S RCSSN=$ $SSN^RCFN0 1(RCDEBT)
  718   "RTN","RCD PRTP0",8,0 )
  719    S RCBIL=0  F  S RCBI L=$O(^PRCA (430,"E",R CDFN,RCBIL )) Q:'RCBI L  D
  720   "RTN","RCD PRTP0",9,0 )
  721    .I $P($G( ^PRCA(430, +RCBIL,0)) ,"^",2)'=9  Q
  722   "RTN","RCD PRTP0",10, 0)
  723    .S RCPAY= 0 F  S RCP AY=$O(^PRC A(433,"C", RCBIL,RCPA Y)) Q:'RCP AY  D
  724   "RTN","RCD PRTP0",11, 0)
  725    ..S RCPAY 1=$G(^PRCA (433,+RCPA Y,1)) Q:RC PAY1=""
  726   "RTN","RCD PRTP0",12, 0)
  727    ..I "^2^3 4^"[("^"_$ P(RCPAY1," ^",2)_"^") ,($P(RCPAY 1,"^",9)'< DATESTRT), ($P(RCPAY1
  728   ,"^",9)<(D ATEEND_".9 99999")) D
  729   "RTN","RCD PRTP0",13, 0)
  730    ...S DFN= RCDFN D DE M^VADPT,EL IG^VADPT
  731   "RTN","RCD PRTP0",14, 0)
  732    ...S ^TMP ("RCDPRTPB ",$J,RCNAM )=$P($G(VA DM(3)),"^" ,2)_"^"_$P ($G(VAEL(1 )),"^",2)_
  733   "^"_RCSSN
  734   "RTN","RCD PRTP0",15, 0)
  735    ...S ^TMP ("RCDPRTPB ",$J,RCNAM ,RCBIL)=$P ($P(RCPAY1 ,"^",9),". ")
  736   "RTN","RCD PRTP0",16, 0)
  737    ...K DFN, VA,VADM,VA EL,VAERR
  738   "RTN","RCD PRTP0",17, 0)
  739    K RCDFN,R CDEBT
  740   "RTN","RCD PRTP0",18, 0)
  741    Q
  742   "RTN","RCD PRTP0",19, 0)
  743    ;
  744   "RTN","RCD PRTP0",20, 0)
  745   DATE ;find  third par ty bills b y date of  payments
  746   "RTN","RCD PRTP0",21, 0)
  747    N RCDFN,R CDEBT
  748   "RTN","RCD PRTP0",22, 0)
  749    F RCTYP=2 ,34 S DAT= (DATESTRT- 1)_".99999 9" F  S DA T=$O(^PRCA (433,"AT", RCTYP,DAT)
  750   ) Q:'DAT!( DAT>(DATEE ND_".99999 9"))  D
  751   "RTN","RCD PRTP0",23, 0)
  752    .S RCPAY= 0 F  S RCP AY=$O(^PRC A(433,"AT" ,RCTYP,DAT ,RCPAY)) Q :'RCPAY  D
  753   "RTN","RCD PRTP0",24, 0)
  754    ..S RCBIL =$P($G(^PR CA(433,+RC PAY,0)),"^ ",2)
  755   "RTN","RCD PRTP0",25, 0)
  756    ..S RCBIL 0=$G(^PRCA (430,+RCBI L,0)) Q:RC BIL0=""
  757   "RTN","RCD PRTP0",26, 0)
  758    ..Q:$P(RC BIL0,"^",2 )'=9
  759   "RTN","RCD PRTP0",27, 0)
  760    ..S RCDFN =$P(RCBIL0 ,"^",7)
  761   "RTN","RCD PRTP0",28, 0)
  762    ..S RCDEB T=$O(^RCD( 340,"B",RC DFN_";DPT( ",0)) Q:'R CDEBT
  763   "RTN","RCD PRTP0",29, 0)
  764    ..S RCNAM =$$NAM^RCF N01(RCDEBT )
  765   "RTN","RCD PRTP0",30, 0)
  766    ..S RCSSN =$$SSN^RCF N01(RCDEBT )
  767   "RTN","RCD PRTP0",31, 0)
  768    ..S DFN=R CDFN D DEM ^VADPT,ELI G^VADPT
  769   "RTN","RCD PRTP0",32, 0)
  770    ..S ^TMP( "RCDPRTPB" ,$J,RCNAM_ "^"_RCDEBT )=$P($G(VA DM(3)),"^" ,2)_"^"_$P ($G(VAEL(1
  771   )),"^",2)_ "^"_RCSSN
  772   "RTN","RCD PRTP0",33, 0)
  773    ..S ^TMP( "RCDPRTPB" ,$J,RCNAM_ "^"_RCDEBT ,RCBIL)=$P (DAT,".")
  774   "RTN","RCD PRTP0",34, 0)
  775    ..K DFN,V A,VADM,VAE L,VAERR
  776   "RTN","RCD PRTP0",35, 0)
  777    Q
  778   "RTN","RCD PRTP0",36, 0)
  779    ;
  780   "RTN","RCD PRTP0",37, 0)
  781   TYPE ;find  third par ty bills b y care typ e
  782   "RTN","RCD PRTP0",38, 0)
  783    N RCDFN,R CDEBT
  784   "RTN","RCD PRTP0",39, 0)
  785    F RCTYP=2 ,34 S DAT= (DATESTRT- 1)_".99999 9" F  S DA T=$O(^PRCA (433,"AT", RCTYP,DAT)
  786   ) Q:'DAT!( DAT>(DATEE ND_".99999 9"))  D
  787   "RTN","RCD PRTP0",40, 0)
  788    .S RCPAY= 0 F  S RCP AY=$O(^PRC A(433,"AT" ,RCTYP,DAT ,RCPAY)) Q :'RCPAY  D
  789   "RTN","RCD PRTP0",41, 0)
  790    ..S RCBIL =$P($G(^PR CA(433,+RC PAY,0)),"^ ",2)
  791   "RTN","RCD PRTP0",42, 0)
  792    ..S RCBIL 0=$G(^PRCA (430,+RCBI L,0)) Q:RC BIL0=""
  793   "RTN","RCD PRTP0",43, 0)
  794    ..Q:$P(RC BIL0,"^",2 )'=9
  795   "RTN","RCD PRTP0",44, 0)
  796    ..S RCDFN =$P(RCBIL0 ,"^",7)
  797   "RTN","RCD PRTP0",45, 0)
  798    ..S RCDEB T=$O(^RCD( 340,"B",RC DFN_";DPT( ",0)) Q:'R CDEBT
  799   "RTN","RCD PRTP0",46, 0)
  800    ..S RCNAM =$$NAM^RCF N01(RCDEBT )
  801   "RTN","RCD PRTP0",47, 0)
  802    ..S RCSSN =$$SSN^RCF N01(RCDEBT )
  803   "RTN","RCD PRTP0",48, 0)
  804    ..S DFN=R CDFN D DEM ^VADPT,ELI G^VADPT
  805   "RTN","RCD PRTP0",49, 0)
  806    ..S RCTYP E=$$TYP^IB RFN(RCBIL)  ; added c are type -  315
  807   "RTN","RCD PRTP0",50, 0)
  808    ..S RCTYP E=$S(RCTYP E="":-1,RC TYPE="PR": "P",RCTYPE ="PH":"R", 1:RCTYPE)
  809   "RTN","RCD PRTP0",51, 0)
  810    ..I $D(RC TYPE(RCTYP E)) D  Q
  811   "RTN","RCD PRTP0",52, 0)
  812    ...S ^TMP ("RCDPRTPB ",$J,RCNAM _"^"_RCDEB T)=$P($G(V ADM(3)),"^ ",2)_"^"_$ P($G(VAEL(
  813   1)),"^",2) _"^"_RCSSN
  814   "RTN","RCD PRTP0",53, 0)
  815    ...S ^TMP ("RCDPRTPB ",$J,RCNAM _"^"_RCDEB T,RCBIL)=$ P(DAT,".")
  816   "RTN","RCD PRTP0",54, 0)
  817    ...K DFN, VA,VADM,VA EL,VAERR
  818   "RTN","RCD PRTP0",55, 0)
  819    ..Q
  820   "RTN","RCD PRTP0",56, 0)
  821    Q
  822   "RTN","RCD PRTP0",57, 0)
  823   BILL ;set  TMP array
  824   "RTN","RCD PRTP0",58, 0)
  825    S RCNAM=$ $NAM^RCFN0 1(RCDEBT)
  826   "RTN","RCD PRTP0",59, 0)
  827    S RCSSN=$ $SSN^RCFN0 1(RCDEBT)
  828   "RTN","RCD PRTP0",60, 0)
  829    S DFN=+$G (^RCD(340, RCDEBT,0))
  830   "RTN","RCD PRTP0",61, 0)
  831    D DEM^VAD PT,ELIG^VA DPT
  832   "RTN","RCD PRTP0",62, 0)
  833    S RCTP=0  F  S RCTP= $O(^PRCA(4 33,"C",RCB ILL,RCTP))  Q:'RCTP   I "^2^34^" [("^"_$P($
  834   G(^PRCA(43 3,+RCTP,1) ),"^",2)_" ^") S RCTP (0)=$P($P( $G(^PRCA(4 33,+RCTP,1 )),"^",9),
  835   ".")
  836   "RTN","RCD PRTP0",63, 0)
  837    S ^TMP("R CDPRTPB",$ J,RCNAM)=$ P($G(VADM( 3)),"^",2) _"^"_$P($G (VAEL(1)), "^",2)_"^"
  838   _RCSSN
  839   "RTN","RCD PRTP0",64, 0)
  840    S ^TMP("R CDPRTPB",$ J,RCNAM,RC BILL)=RCTP
  841   "RTN","RCD PRTP0",65, 0)
  842    K DFN,VA, VADM,VAEL, VAERR,RCBI LL,RCTP
  843   "RTN","RCD PRTP0",66, 0)
  844    Q
  845   "RTN","RCD PRTP0",67, 0)
  846    ;
  847   "RTN","RCD PRTP0",68, 0)
  848   REC ;find  receipt pa yments
  849   "RTN","RCD PRTP0",69, 0)
  850    N RCDEBT, RCDFN
  851   "RTN","RCD PRTP0",70, 0)
  852    S RCREC1= 0 F  S RCR EC1=$O(^PR CA(433,"AF ",RCPT,RCR EC1)) Q:'R CREC1  D
  853   "RTN","RCD PRTP0",71, 0)
  854    .S RCPAY1 =$G(^PRCA( 433,+RCREC 1,1)) Q:RC PAY1=""
  855   "RTN","RCD PRTP0",72, 0)
  856    .S RCBIL= 0 I "^2^34 ^"[("^"_$P (RCPAY1,"^ ",2)_"^")  S RCBIL=$P ($G(^PRCA( 433,+RCREC
  857   1,0)),"^", 2)
  858   "RTN","RCD PRTP0",73, 0)
  859    .Q:'RCBIL
  860   "RTN","RCD PRTP0",74, 0)
  861    .S RCBIL0 =$G(^PRCA( 430,+RCBIL ,0))
  862   "RTN","RCD PRTP0",75, 0)
  863    .Q:$P(RCB IL0,"^",2) '=9
  864   "RTN","RCD PRTP0",76, 0)
  865    .S RCDFN= $P(RCBIL0, "^",7) Q:' RCDFN
  866   "RTN","RCD PRTP0",77, 0)
  867    .S RCDEBT =$O(^RCD(3 40,"B",RCD FN_";DPT(" ,0)) Q:'RC DEBT
  868   "RTN","RCD PRTP0",78, 0)
  869    .S RCSSN= $$SSN^RCFN 01(RCDEBT)
  870   "RTN","RCD PRTP0",79, 0)
  871    .S RCNAM= $$NAM^RCFN 01(RCDEBT)
  872   "RTN","RCD PRTP0",80, 0)
  873    .S DFN=RC DFN D DEM^ VADPT,ELIG ^VADPT
  874   "RTN","RCD PRTP0",81, 0)
  875    .S ^TMP(" RCDPRTPB", $J,RCNAM_" ^"_RCDEBT) =$P($G(VAD M(3)),"^", 2)_"^"_$P( $G(VAEL(1)
  876   ),"^",2)_" ^"_RCSSN
  877   "RTN","RCD PRTP0",82, 0)
  878    .K DFN,VA ,VADM,VAEL ,VAERR
  879   "RTN","RCD PRTP0",83, 0)
  880    .S ^TMP(" RCDPRTPB", $J,RCNAM_" ^"_RCDEBT, RCBIL)=$P( $P($G(^PRC A(433,+RCR EC1,1)),"^
  881   ",9),".")
  882   "RTN","RCD PRTP0",84, 0)
  883    Q
  884   "RTN","RCD PRTP0",85, 0)
  885    ;
  886   "RTN","RCD PRTP0",86, 0)
  887   TYPEPIC(RC TYPE) ; fu nction for  user sele ction of c are types
  888   "RTN","RCD PRTP0",87, 0)
  889    ; RCTYPE  is an outp ut array,  pass by re ference
  890   "RTN","RCD PRTP0",88, 0)
  891    ; RCTYPE( type)="" w here type  can be (I) npatient,  (O)utpatie nt,(P)rost hetics or 
  892   (R)x (Pres cription)
  893   "RTN","RCD PRTP0",89, 0)
  894    ; Functio n value is  1 if at l east 1 car e type was  selected,  0 otherwi se
  895   "RTN","RCD PRTP0",90, 0)
  896    ; User ca n select o ne, all or  a combina tion of ca re types.
  897   "RTN","RCD PRTP0",91, 0)
  898    ;
  899   "RTN","RCD PRTP0",92, 0)
  900    N DIR,X,Y ,OK,DTOUT, DUOUT,DIRU T,DIROUT,R C
  901   "RTN","RCD PRTP0",93, 0)
  902    K RCTYPE
  903   "RTN","RCD PRTP0",94, 0)
  904    S OK=1 ;  all OK def ault
  905   "RTN","RCD PRTP0",95, 0)
  906    F  D  Q:Y ="ALL"!$D( DIRUT)!(Y= "")
  907   "RTN","RCD PRTP0",96, 0)
  908    . S DIR(0 )="SO"
  909   "RTN","RCD PRTP0",97, 0)
  910    . S RC="; I:"_$$LJ^X LFSTR("Inp atient",15 )_$S($D(RC TYPE("I")) :"SELECTED ",1:"")
  911   "RTN","RCD PRTP0",98, 0)
  912    . S RC=RC _";O:"_$$L J^XLFSTR(" Outpatient ",15)_$S($ D(RCTYPE(" O")):"SELE CTED",1:""
  913   )
  914   "RTN","RCD PRTP0",99, 0)
  915    . S RC=RC _";P:"_$$L J^XLFSTR(" Prosthetic ",15)_$S($ D(RCTYPE(" P")):"SELE CTED",1:""
  916   )
  917   "RTN","RCD PRTP0",100 ,0)
  918    . S RC=RC _";R:"_$$L J^XLFSTR(" Prescripti on",15)_$S ($D(RCTYPE ("R")):"SE LECTED",1:
  919   "")
  920   "RTN","RCD PRTP0",101 ,0)
  921    . S RC=RC _";ALL:All "
  922   "RTN","RCD PRTP0",102 ,0)
  923    . S $P(DI R(0),U,2)= RC
  924   "RTN","RCD PRTP0",103 ,0)
  925    . I '$D(R CTYPE) S D IR("A")="S elect a Ca re Type",D IR("B")="A LL"
  926   "RTN","RCD PRTP0",104 ,0)
  927    . E  S DI R("A")="Se lect anoth er Care Ty pe" K DIR( "B")
  928   "RTN","RCD PRTP0",105 ,0)
  929    . W ! D ^ DIR K DIR
  930   "RTN","RCD PRTP0",106 ,0)
  931    . I Y="AL L" D  Q ;  all types  selected s o set & qu it
  932   "RTN","RCD PRTP0",107 ,0)
  933    . . F X=" I","O","P" ,"R" S RCT YPE(X)=""
  934   "RTN","RCD PRTP0",108 ,0)
  935    . ;
  936   "RTN","RCD PRTP0",109 ,0)
  937    . I $D(DI RUT)!(Y="" ) Q
  938   "RTN","RCD PRTP0",110 ,0)
  939    . I $D(RC TYPE(Y)) K  RCTYPE(Y)  Q  ; If a lready sel ected, tog gle off &  quit
  940   "RTN","RCD PRTP0",111 ,0)
  941    . S RCTYP E(Y)=""                   ; Togg le back on
  942   "RTN","RCD PRTP0",112 ,0)
  943    . Q
  944   "RTN","RCD PRTP0",113 ,0)
  945    I $D(DUOU T)!$D(DTOU T) S OK=0      ; exit  if "^" or  time-out
  946   "RTN","RCD PRTP0",114 ,0)
  947    I '$D(RCT YPE) S OK= 0 W $C(7)
  948   "RTN","RCD PRTP0",115 ,0)
  949    Q OK
  950   "RTN","RCD PRTP0",116 ,0)
  951    ;
  952   "RTN","RCD PRTP2")
  953   0^8^B17924 750
  954   "RTN","RCD PRTP2",1,0 )
  955   RCDPRTP2 ; ALB/LDB -  CLAIMS MAT CHING REPO RT ;1/26/0 1  3:16 PM
  956   "RTN","RCD PRTP2",2,0 )
  957    ;;4.5;Acc ounts Rece ivable;**1 51,276,303 ,315**;Mar  20, 1995; Build 1
  958   "RTN","RCD PRTP2",3,0 )
  959    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  960   "RTN","RCD PRTP2",4,0 )
  961    ;
  962   "RTN","RCD PRTP2",5,0 )
  963    ; Referen ce to $$TY P^IBRFN su pported by  DBIA# 203 1
  964   "RTN","RCD PRTP2",6,0 )
  965    ;
  966   "RTN","RCD PRTP2",7,0 )
  967   PRINT1 ;
  968   "RTN","RCD PRTP2",8,0 )
  969    N REJECT, RCTYP
  970   "RTN","RCD PRTP2",9,0 )
  971    I $Y>(IOS L-2) D PAU SE Q:$G(RC Q)  D HDR^ RCDPRTP1,H DR1
  972   "RTN","RCD PRTP2",10, 0)
  973    ; PRCA*4. 5*276 - ge t EEOB ind icator '%' and attach  it to the  bill numb er when ap
  974   plicable.  Adjust rep ort tabs t o make roo m for EEOB  indicator  '%'.
  975   "RTN","RCD PRTP2",11, 0)
  976    N RC430 S  RC430=+$O (^PRCA(430 ,"B",""_$P (RCIBDAT," ^",4)_"",0 ))
  977   "RTN","RCD PRTP2",12, 0)
  978    S RCEEOB= $$EEOB(RC4 30)
  979   "RTN","RCD PRTP2",13, 0)
  980    ; #IA 606 0 for $$BI LLREJ^IBJT U6
  981   "RTN","RCD PRTP2",14, 0)
  982    S REJECT= $S($$BILLR EJ^IBJTU6( $P($P(RCIB DAT,"^",4) ,"-",2)):" c",1:" ")  ;PRCA*4.5*
  983   303 Add in dicator fo r rejects
  984   "RTN","RCD PRTP2",15, 0)
  985    W !,$S(RC TP=RCBILL: "*",$D(RCT P(RCTP)):" *",1:" "), $G(RCEEOB) _REJECT_$P (RCIBDAT,"
  986   ^",4),?17, $P(RCIBDAT ,"^",5),?2 4
  987   "RTN","RCD PRTP2",16, 0)
  988    W $$STAT( RCTP),?31, $$DATE(+RC IBDAT),?42 ,$$DATE($P (RCIBDAT," ^",2))
  989   "RTN","RCD PRTP2",17, 0)
  990    S Y=$S($G (RCTP(RCTP )):RCTP(RC TP),$G(^TM P("RCDPRTP B",$J,RCNA M,RCBILL)) :^(RCBILL)
  991   ,1:"") I R CTP=RCBILL !($D(RCTP( RCTP))) W  ?53,$$DATE (Y)
  992   "RTN","RCD PRTP2",18, 0)
  993    S RCAMT=$ P($G(^PRCA (430,+RCTP ,0)),"^",3 ),RCAMT1=$ P($G(^PRCA (430,+RCTP ,7)),"^",7
  994   ) W ?64,$J (RCAMT,9,2 )
  995   "RTN","RCD PRTP2",19, 0)
  996    W ?76,$J( RCAMT1,9,2 ) S RCAMT( 0)=RCAMT(0 )+RCAMT,RC AMT(1)=RCA MT(1)+RCAM T1
  997   "RTN","RCD PRTP2",20, 0)
  998    W ?88,$E( $P(RCIBDAT ,"^",7),1, 25)
  999   "RTN","RCD PRTP2",21, 0)
  1000    ; #IA 203 1 for $$TY P^IBRFN
  1001   "RTN","RCD PRTP2",22, 0)
  1002    S RCTYP=$ $TYP^IBRFN (RCTP) ; g et bill ty pe for an  Accounts R eceivable
  1003   "RTN","RCD PRTP2",23, 0)
  1004    ; Convert  to single  character  care type s for: 
  1005   "RTN","RCD PRTP2",24, 0)
  1006    ; (I)npat ient, (O)u tpatient,  (R)Prescri ption & (P )rosthetic s
  1007   "RTN","RCD PRTP2",25, 0)
  1008    S RCTYP=$ S(RCTYP="" :-1,RCTYP= "PR":"P",R CTYP="PH": "R",1:RCTY P)
  1009   "RTN","RCD PRTP2",26, 0)
  1010    W ?117,RC TYP
  1011   "RTN","RCD PRTP2",27, 0)
  1012    K RCTP(RC TP)
  1013   "RTN","RCD PRTP2",28, 0)
  1014    Q
  1015   "RTN","RCD PRTP2",29, 0)
  1016    ;
  1017   "RTN","RCD PRTP2",30, 0)
  1018   PRINT2  ;  Print the  detail lin e for a fi rst party  bill.
  1019   "RTN","RCD PRTP2",31, 0)
  1020    I $Y>(IOS L-2) D PAU SE Q:$G(RC Q)  D HDR^ RCDPRTP1,H DR2
  1021   "RTN","RCD PRTP2",32, 0)
  1022    W !," ",$ P(RCIBDAT, "^",4),?14 ,$P(RCIBDA T,"^",6)
  1023   "RTN","RCD PRTP2",33, 0)
  1024    S RCIBFN= $P(RCIBDAT ,"^",4) I  RCIBFN S R CIBFN=$O(^ PRCA(430," B",RCIBFN, 0))
  1025   "RTN","RCD PRTP2",34, 0)
  1026    ; PRCA*4. 5*276 - ad just repor t tabs to  make room  for EEOB i ndicator ' %'.
  1027   "RTN","RCD PRTP2",35, 0)
  1028    W ?36,$$S TAT(RCIBFN ),?42,$$DA TE(+RCIBDA T),?54,$$D ATE($P(RCI BDAT,"^",2 ))
  1029   "RTN","RCD PRTP2",36, 0)
  1030    W ?66,$J( $P(RCIBDAT ,"^",5),9, 2),?78,$P( RCIBDAT,"^ ",7)
  1031   "RTN","RCD PRTP2",37, 0)
  1032    W ?87,$J( $S($G(^PRC A(430,+RCI BFN,7)):+( $P(^(7),"^ ")+$P(^(7) ,"^",2)+$P (^(7),"^",
  1033   3)+$P(^(7) ,"^",4)+$P (^(7),"^", 4)),1:0),9 ,2)
  1034   "RTN","RCD PRTP2",38, 0)
  1035    Q
  1036   "RTN","RCD PRTP2",39, 0)
  1037    ;
  1038   "RTN","RCD PRTP2",40, 0)
  1039    ;
  1040   "RTN","RCD PRTP2",41, 0)
  1041   PRINT3 ; P rint patie nt detail  informatio n.
  1042   "RTN","RCD PRTP2",42, 0)
  1043    I $Y>(IOS L-5) D PAU SE Q:$G(RC Q)  D HDR^ RCDPRTP1
  1044   "RTN","RCD PRTP2",43, 0)
  1045    S RCNAM1= ^TMP("RCDP RTPB",$J,R CNAM)
  1046   "RTN","RCD PRTP2",44, 0)
  1047    W !!,RCLI NE
  1048   "RTN","RCD PRTP2",45, 0)
  1049    W !,"NAME : ",$P(RCN AM,"^"),"  (",$E($P(R CNAM1,"^", 3),6,9)_") "
  1050   "RTN","RCD PRTP2",46, 0)
  1051    W !,"Prim . Elig: ", $P(RCNAM1, "^",2)
  1052   "RTN","RCD PRTP2",47, 0)
  1053    W ?44,"DO B: ",$P(RC NAM1,"^")
  1054   "RTN","RCD PRTP2",48, 0)
  1055    W ?61,"RX  COVERAGE:  ",$S('$G( ^TMP("IBRB T",$J,RCBI LL)):"NO", 1:"YES")
  1056   "RTN","RCD PRTP2",49, 0)
  1057    W !,RCLIN E
  1058   "RTN","RCD PRTP2",50, 0)
  1059    Q
  1060   "RTN","RCD PRTP2",51, 0)
  1061    ;
  1062   "RTN","RCD PRTP2",52, 0)
  1063   HDR1    ;
  1064   "RTN","RCD PRTP2",53, 0)
  1065    W !!,"Thi rd Party B ills: * ->  bill for  which paym ent was po sted"
  1066   "RTN","RCD PRTP2",54, 0)
  1067    W !,"==== ========== ========== ====="
  1068   "RTN","RCD PRTP2",55, 0)
  1069    ; PRCA*4. 5*276 - ad just repor t tabs to  make room  for EEOB i ndicator ' %'.
  1070   "RTN","RCD PRTP2",56, 0)
  1071    ; PRCA*4. 5*315 - ad ded 1-char . care typ e (I)npati ent, (O)ut patient, ( R)x or (P)
  1072   rosthetics ) under ne w Type col umn
  1073   "RTN","RCD PRTP2",57, 0)
  1074    W !!,"Bil l #",?15," P/S/T",?22 ,"Status", ?30,"Bill  From",?42, "Bill To", ?53,"Poste
  1075   d",?63,"Am t Billed", ?76,"Amt P aid",?88," Payor",?11 5,"Type"
  1076   "RTN","RCD PRTP2",58, 0)
  1077    W !,"---- ---------" ,?15,"---- -",?22,"-- ----",?30, "--------- ",?42,"--- -----",?53
  1078   ,"-------- ",?63,"--- -------",? 75,"------ ----",?88, "--------- ---------- ------",?1
  1079   15,"----"
  1080   "RTN","RCD PRTP2",59, 0)
  1081    Q
  1082   "RTN","RCD PRTP2",60, 0)
  1083    ;
  1084   "RTN","RCD PRTP2",61, 0)
  1085   HDR2 ;
  1086   "RTN","RCD PRTP2",62, 0)
  1087    W !!,"Ass ociated Fi rst Party  Charges:"
  1088   "RTN","RCD PRTP2",63, 0)
  1089    W !,"==== ========== ========== ======="
  1090   "RTN","RCD PRTP2",64, 0)
  1091    W !," Bil l #",?14," Charge Typ e",?34,"St atus",?42, "From/Fill ",?54,"To/ Rel",?65,"
  1092   Amt Billed ",?78,"On  Hold",?87, "  Balance "
  1093   "RTN","RCD PRTP2",65, 0)
  1094    W !,"---- -------",? 14,"------ ---------- ",?34,"--- ---",?42," ---------" ,?54,"----
  1095   -----",?65 ,"-------- --",?78,"- ------",?8 7," ------ ----"
  1096   "RTN","RCD PRTP2",66, 0)
  1097    Q
  1098   "RTN","RCD PRTP2",67, 0)
  1099    ;
  1100   "RTN","RCD PRTP2",68, 0)
  1101   STAT(RCIBF N) ;AR Sta tus
  1102   "RTN","RCD PRTP2",69, 0)
  1103    I '$G(RCI BFN) Q ""
  1104   "RTN","RCD PRTP2",70, 0)
  1105    N RCSTAT
  1106   "RTN","RCD PRTP2",71, 0)
  1107    S RCSTAT= $P($G(^PRC A(430,+RCI BFN,0)),"^ ",8),RCSTA T=$P($G(^P RCA(430.3, +RCSTAT,0)
  1108   ),"^",2)
  1109   "RTN","RCD PRTP2",72, 0)
  1110    Q RCSTAT
  1111   "RTN","RCD PRTP2",73, 0)
  1112    ;
  1113   "RTN","RCD PRTP2",74, 0)
  1114   DATE(X) ;  Convert Fi leMan date  to mm/dd/ yy
  1115   "RTN","RCD PRTP2",75, 0)
  1116    Q $S($G(X ):$E(X,4,5 )_"/"_$E(X ,6,7)_"/"_ $E(X,2,3), 1:"")
  1117   "RTN","RCD PRTP2",76, 0)
  1118    ;
  1119   "RTN","RCD PRTP2",77, 0)
  1120    ;
  1121   "RTN","RCD PRTP2",78, 0)
  1122   PAUSE ; Pa ge break.
  1123   "RTN","RCD PRTP2",79, 0)
  1124    I $E(IOST ,1,2)'="C- " Q
  1125   "RTN","RCD PRTP2",80, 0)
  1126    N RCX,DIR ,DIRUT,DUO UT,DTOUT,D IROUT,X,Y
  1127   "RTN","RCD PRTP2",81, 0)
  1128    I IOSL<10 0 F RCX=$Y :1:(IOSL-3 ) W !
  1129   "RTN","RCD PRTP2",82, 0)
  1130    S DIR(0)= "E" D ^DIR  I $D(DIRU T)!($D(DUO UT)) S RCQ =1
  1131   "RTN","RCD PRTP2",83, 0)
  1132    Q
  1133   "RTN","RCD PRTP2",84, 0)
  1134    ;
  1135   "RTN","RCD PRTP2",85, 0)
  1136   EEOB(RCBIL L) ; PRCA* 4.5*276 -  get EEOB i ndicator f or a bill
  1137   "RTN","RCD PRTP2",86, 0)
  1138    ; Interac tion with  IB file #3 61.1 cover ed by IA # 4051.
  1139   "RTN","RCD PRTP2",87, 0)
  1140    ; RCBILL  is the IEN  of the bi ll in file s #399/#43 0 and must  be valid,
  1141   "RTN","RCD PRTP2",88, 0)
  1142    ; Exclude  an EOB ty pe of MRA  when getti ng payment  informati on. Return
  1143   "RTN","RCD PRTP2",89, 0)
  1144    ; the EEO B indicato r '%' if p ayment act ivity was  found.
  1145   "RTN","RCD PRTP2",90, 0)
  1146    ;
  1147   "RTN","RCD PRTP2",91, 0)
  1148    N RCEEOB, RCVAL,Z
  1149   "RTN","RCD PRTP2",92, 0)
  1150    I $G(RCBI LL)=0 Q ""
  1151   "RTN","RCD PRTP2",93, 0)
  1152    I '$O(^IB M(361.1,"B ",RCBILL,0 )) Q ""  ;  no matchi ng entry f or bill
  1153   "RTN","RCD PRTP2",94, 0)
  1154    I $P($G(^ DGCR(399,R CBILL,0)), "^",13)=1  Q ""  ;avo id 'ENTERE D/NOT REVI EWED' stat
  1155   us
  1156   "RTN","RCD PRTP2",95, 0)
  1157    ; handle  both singl e and mult iple bill  entries in  file #361 .1
  1158   "RTN","RCD PRTP2",96, 0)
  1159    S Z=0 F   S Z=$O(^IB M(361.1,"B ",RCBILL,Z )) Q:'Z  D   Q:$G(RCE EOB)="%"
  1160   "RTN","RCD PRTP2",97, 0)
  1161    . S RCVAL =$G(^IBM(3 61.1,Z,0))
  1162   "RTN","RCD PRTP2",98, 0)
  1163    . S RCEEO B=$S($P(RC VAL,"^",4) =1:"",$P(R CVAL,"^",4 )=0:"%",1: "")
  1164   "RTN","RCD PRTP2",99, 0)
  1165    Q RCEEOB   ; EEOB in dicator fo r 1st/3rd  party paym ent on bil l
  1166   "RTN","RCR JRCOR")
  1167   0^4^B66950 576
  1168   "RTN","RCR JRCOR",1,0 )
  1169   RCRJRCOR ; WISC/RFJ-a r data col lector sum mary repor t ;1 Mar 9 7
  1170   "RTN","RCR JRCOR",2,0 )
  1171    ;;4.5;Acc ounts Rece ivable;**6 8,96,139,1 03,156,170 ,174,191,2 20,138,239 **;Mar 20,
  1172    1995;Buil d 1
  1173   "RTN","RCR JRCOR",3,0 )
  1174    ;;Per VHA  Directive  10-93-142 , this rou tine shoul d not be m odified.
  1175   "RTN","RCR JRCOR",4,0 )
  1176    Q
  1177   "RTN","RCR JRCOR",5,0 )
  1178    ;
  1179   "RTN","RCR JRCOR",6,0 )
  1180    ;
  1181   "RTN","RCR JRCOR",7,0 )
  1182   SEND ;  se nd data to  ndb and d ata to FMS
  1183   "RTN","RCR JRCOR",8,0 )
  1184    N %,AMOUN T,DATEMOYR ,FUND,LINE ,RSC,SPACE ,TOTAL,TOT ALFUN,TOTA LTYP,TYPE, X,XMY,Y
  1185   "RTN","RCR JRCOR",9,0 )
  1186    ;
  1187   "RTN","RCR JRCOR",10, 0)
  1188    ;  ------ ---- send  to ndb --- -------
  1189   "RTN","RCR JRCOR",11, 0)
  1190    ;  data s tored in t mp($j,rcrj rcolndb)
  1191   "RTN","RCR JRCOR",12, 0)
  1192    I '$G(RCR JFAR1) D N DB(PRCASIT E,DATEBEG, DATEEND)
  1193   "RTN","RCR JRCOR",13, 0)
  1194    ;
  1195   "RTN","RCR JRCOR",14, 0)
  1196    ;
  1197   "RTN","RCR JRCOR",15, 0)
  1198    ;  ------ ---- send  sv to fms  ----------
  1199   "RTN","RCR JRCOR",16, 0)
  1200    ;  data s tored in t mp($j,rcrj rcolsv)
  1201   "RTN","RCR JRCOR",17, 0)
  1202    ;  rcrjfs v is a fla g set in t he routine  rcrjrco f or retrans mission
  1203   "RTN","RCR JRCOR",18, 0)
  1204    ;  to pre vent accep ted fms do cuments fr om being r esent
  1205   "RTN","RCR JRCOR",19, 0)
  1206    I '$G(RCR JFSV) D ST ARTSV^RCXF MSSV(DATEE ND)
  1207   "RTN","RCR JRCOR",20, 0)
  1208    ;
  1209   "RTN","RCR JRCOR",21, 0)
  1210    ;
  1211   "RTN","RCR JRCOR",22, 0)
  1212    ;  ------ ---- send  wr to fms  ----------
  1213   "RTN","RCR JRCOR",23, 0)
  1214    ;  data s tored in t mp($j,rcrj rcolwr)
  1215   "RTN","RCR JRCOR",24, 0)
  1216    ;  rcrjfw r is a fla g set in t he routine  rcrjrco f or retrans mission
  1217   "RTN","RCR JRCOR",25, 0)
  1218    ;  to pre vent accep ted fms do cuments fr om being r esent
  1219   "RTN","RCR JRCOR",26, 0)
  1220    I '$G(RCR JFWR) D ST ARTWR^RCXF MSWR(DATEE ND)
  1221   "RTN","RCR JRCOR",27, 0)
  1222    ;
  1223   "RTN","RCR JRCOR",28, 0)
  1224    ;  ------ ---- send  tr to fms  ----------
  1225   "RTN","RCR JRCOR",29, 0)
  1226    N RCTRANS
  1227   "RTN","RCR JRCOR",30, 0)
  1228    ;  this c all return s rctrans  array (see  rcxfmstx  for descri ption)
  1229   "RTN","RCR JRCOR",31, 0)
  1230    ;  rcrjft r is a fla g set in t he routine  rcrjrco f or retrans mission
  1231   "RTN","RCR JRCOR",32, 0)
  1232    ;  to pre vent accep ted fms do cuments fr om being r esent
  1233   "RTN","RCR JRCOR",33, 0)
  1234    I '$G(RCR JFTR) D ST ARTTR^RCXF MSTX(DATEE ND)
  1235   "RTN","RCR JRCOR",34, 0)
  1236    ;
  1237   "RTN","RCR JRCOR",35, 0)
  1238    ;  ------ ---- send  oig extrac t -------- --
  1239   "RTN","RCR JRCOR",36, 0)
  1240    ;  data s tored in t mp(j,rcrjr oig)
  1241   "RTN","RCR JRCOR",37, 0)
  1242    ;  get no n-mccf bil ls for ext ract and u ser report
  1243   "RTN","RCR JRCOR",38, 0)
  1244    D NONMCCF ^RCRJROIG( DATEEND)
  1245   "RTN","RCR JRCOR",39, 0)
  1246    ;  rcrjfo ig is a fl ag set in  the routin e rcrjrco  for retran smission
  1247   "RTN","RCR JRCOR",40, 0)
  1248    ;  to pre vent the o ig extract  from bein g resent
  1249   "RTN","RCR JRCOR",41, 0)
  1250    I '$G(RCR JFOIG) D O IG^RCRJROI G(DATEEND)
  1251   "RTN","RCR JRCOR",42, 0)
  1252    ;
  1253   "RTN","RCR JRCOR",43, 0)
  1254    ;  genera te a mailm an message  to the gr oup showin g the data
  1255   "RTN","RCR JRCOR",44, 0)
  1256    K ^TMP($J ,"RCRJRCOR MM")
  1257   "RTN","RCR JRCOR",45, 0)
  1258    S Y=$E(DA TEEND,1,5) _"00" D DD ^%DT S DAT EMOYR=Y
  1259   "RTN","RCR JRCOR",46, 0)
  1260    S LINE=0, SPACE="",$ P(SPACE,"  ",80)=""
  1261   "RTN","RCR JRCOR",47, 0)
  1262    D SET("Da ta has bee n collecte d for the  month "_DA TEMOYR_".   The data  has been")
  1263   "RTN","RCR JRCOR",48, 0)
  1264    D SET("tr ansmitted  to the fol lowing sys tems:")
  1265   "RTN","RCR JRCOR",49, 0)
  1266    D SET(" " )
  1267   "RTN","RCR JRCOR",50, 0)
  1268    ;
  1269   "RTN","RCR JRCOR",51, 0)
  1270    I '$G(RCR JFAR1) D
  1271   "RTN","RCR JRCOR",52, 0)
  1272    .   D SET ("NATIONAL  DATABASE  DATA")
  1273   "RTN","RCR JRCOR",53, 0)
  1274    .   D SET ("-------- ---------- ----")
  1275   "RTN","RCR JRCOR",54, 0)
  1276    .   D SET ("The data  has been  sent to th e National  Database.   For a de tail list"
  1277   )
  1278   "RTN","RCR JRCOR",55, 0)
  1279    .   D SET ("of the d ata sent,  please rev iew the Re turn Repor ts which a re sent")
  1280   "RTN","RCR JRCOR",56, 0)
  1281    .   D SET ("from the  National  Database." )
  1282   "RTN","RCR JRCOR",57, 0)
  1283    .   D SET (" ")
  1284   "RTN","RCR JRCOR",58, 0)
  1285    ;
  1286   "RTN","RCR JRCOR",59, 0)
  1287    I '$G(RCR JFSV) D
  1288   "RTN","RCR JRCOR",60, 0)
  1289    .   D SET ("FMS, STA NDARD VOUC HER (SV) D OCUMENT")
  1290   "RTN","RCR JRCOR",61, 0)
  1291    .   D SET ("-------- ---------- ---------- -------")
  1292   "RTN","RCR JRCOR",62, 0)
  1293    .   D SET ("The foll owing data  has been  transmitte d to FMS i n the SV d ocument:")
  1294   "RTN","RCR JRCOR",63, 0)
  1295    .   D SET ("  Revenu e Source C ode                                            Type   
  1296       Amount ")
  1297   "RTN","RCR JRCOR",64, 0)
  1298    .   D SET ("  ------ ---------- ---                                            ----   
  1299       ------ ")
  1300   "RTN","RCR JRCOR",65, 0)
  1301    .   S TOT AL=0
  1302   "RTN","RCR JRCOR",66, 0)
  1303    .   S TYP E="" F  S  TYPE=$O(^T MP($J,"RCR JRCOLSV",T YPE)) Q:TY PE=""  D
  1304   "RTN","RCR JRCOR",67, 0)
  1305    .   .   I  TYPE=17!( TYPE=18) Q     ; disp lay the Me dicare tot als later
  1306   "RTN","RCR JRCOR",68, 0)
  1307    .   .   S  TOTALTYP= 0
  1308   "RTN","RCR JRCOR",69, 0)
  1309    .   .   S  FUND="" F   S FUND=$ O(^TMP($J, "RCRJRCOLS V",TYPE,FU ND)) Q:FUN D=""  D
  1310   "RTN","RCR JRCOR",70, 0)
  1311    .   .   .    S TOTAL FUN=0
  1312   "RTN","RCR JRCOR",71, 0)
  1313    .   .   .    S RSC=" " F  S RSC =$O(^TMP($ J,"RCRJRCO LSV",TYPE, FUND,RSC))  Q:RSC="" 
  1314    S AMOUNT= ^(RSC) D
  1315   "RTN","RCR JRCOR",72, 0)
  1316    .   .   .    .   D S ET("  "_RS C_" "_$E($ $GETDESC^R CXFMSPR(RS C)_SPACE,1 ,54)_"  "_
  1317   TYPE_$J(AM OUNT,13,2) )
  1318   "RTN","RCR JRCOR",73, 0)
  1319    .   .   .    .   S T OTALFUN=TO TALFUN+AMO UNT
  1320   "RTN","RCR JRCOR",74, 0)
  1321    .   .   .    .   S T OTALTYP=TO TALTYP+AMO UNT
  1322   "RTN","RCR JRCOR",75, 0)
  1323    .   .   .    .   S T OTAL=TOTAL +AMOUNT
  1324   "RTN","RCR JRCOR",76, 0)
  1325    .   .   .    ;
  1326   "RTN","RCR JRCOR",77, 0)
  1327    .   .   .    N RCFUN D S RCFUND =$S($E(DAT EEND,2,5)< "0410":$E( FUND,1,4)_ "."_$E(FUN
  1328   D,6),1:$E( FUND,1,4)_ "0"_$E(FUN D,6))
  1329   "RTN","RCR JRCOR",78, 0)
  1330    .   .   .    I TYPE= 21 D SET($ E("             Sub-T otal by Fu nd "_RCFUN D_":"_SPAC
  1331   E,1,38)_$J (TOTALFUN, 12,2))
  1332   "RTN","RCR JRCOR",79, 0)
  1333    .   .   ;
  1334   "RTN","RCR JRCOR",80, 0)
  1335    .   .   D  SET("                                                                      
  1336       ------ ----")
  1337   "RTN","RCR JRCOR",81, 0)
  1338    .   .   D  SET("                                                         TO TAL TYPE "
  1339   _TYPE_$J(T OTALTYP,13 ,2))
  1340   "RTN","RCR JRCOR",82, 0)
  1341    .   .   D  SET(" ")
  1342   "RTN","RCR JRCOR",83, 0)
  1343    .   ;
  1344   "RTN","RCR JRCOR",84, 0)
  1345    .   ; Dis play Medic are totals  and updat e the SV t otal
  1346   "RTN","RCR JRCOR",85, 0)
  1347    .   S AMO UNT=+$G(^T MP($J,"RCR JRCOLSV",1 7)),TOTAL= TOTAL+AMOU NT
  1348   "RTN","RCR JRCOR",86, 0)
  1349    .   D SET ("       M edicare Co ntractual  Adjustment                TOTAL  TYPE 17"_$
  1350   J(AMOUNT,1 3,2))
  1351   "RTN","RCR JRCOR",87, 0)
  1352    .   S AMO UNT=+$G(^T MP($J,"RCR JRCOLSV",1 8)),TOTAL= TOTAL+AMOU NT
  1353   "RTN","RCR JRCOR",88, 0)
  1354    .   D SET ("       U nreimbursa ble Medica re Expense                TOTAL  TYPE 18"_$
  1355   J(AMOUNT,1 3,2))
  1356   "RTN","RCR JRCOR",89, 0)
  1357    .   D SET (" ")
  1358   "RTN","RCR JRCOR",90, 0)
  1359    .   ;
  1360   "RTN","RCR JRCOR",91, 0)
  1361    .   D SET ("                                                                          
  1362   ---------- ")
  1363   "RTN","RCR JRCOR",92, 0)
  1364    .   D SET ("                                                              T OTAL SV"_$
  1365   J(TOTAL,13 ,2))
  1366   "RTN","RCR JRCOR",93, 0)
  1367    .   D SET (" ")
  1368   "RTN","RCR JRCOR",94, 0)
  1369    ;
  1370   "RTN","RCR JRCOR",95, 0)
  1371    I '$G(RCR JFWR) D
  1372   "RTN","RCR JRCOR",96, 0)
  1373    .   D SET ("FMS, WRI TEOFFS/CON TRACT ADJU STMENTS (W R) DOCUMEN T")
  1374   "RTN","RCR JRCOR",97, 0)
  1375    .   D SET ("-------- ---------- ---------- ---------- ---------- -")
  1376   "RTN","RCR JRCOR",98, 0)
  1377    .   D SET ("The foll owing data  has been  transmitte d to FMS i n the WR d ocument:")
  1378   "RTN","RCR JRCOR",99, 0)
  1379    .   D SET ("  Revenu e Source C ode                                            Type   
  1380       Amount ")
  1381   "RTN","RCR JRCOR",100 ,0)
  1382    .   D SET ("  ------ ---------- ---                                            ----   
  1383       ------ ")
  1384   "RTN","RCR JRCOR",101 ,0)
  1385    .   S TOT AL=0
  1386   "RTN","RCR JRCOR",102 ,0)
  1387    .   S TYP E="" F  S  TYPE=$O(^T MP($J,"RCR JRCOLWR",T YPE)) Q:TY PE=""  D
  1388   "RTN","RCR JRCOR",103 ,0)
  1389    .   .   S  TOTALTYP= 0
  1390   "RTN","RCR JRCOR",104 ,0)
  1391    .   .   S  FUND="" F   S FUND=$ O(^TMP($J, "RCRJRCOLW R",TYPE,FU ND)) Q:FUN D=""  D
  1392   "RTN","RCR JRCOR",105 ,0)
  1393    .   .   .    S TOTAL FUN=0
  1394   "RTN","RCR JRCOR",106 ,0)
  1395    .   .   .    S RSC=" " F  S RSC =$O(^TMP($ J,"RCRJRCO LWR",TYPE, FUND,RSC))  Q:RSC="" 
  1396    S AMOUNT= ^(RSC) D
  1397   "RTN","RCR JRCOR",107 ,0)
  1398    .   .   .    .   D S ET("  "_RS C_" "_$E($ $GETDESC^R CXFMSPR(RS C)_SPACE,1 ,54)_"  "_
  1399   TYPE_$J(AM OUNT,13,2) )
  1400   "RTN","RCR JRCOR",108 ,0)
  1401    .   .   .    .   S T OTALFUN=TO TALFUN+AMO UNT
  1402   "RTN","RCR JRCOR",109 ,0)
  1403    .   .   .    .   S T OTALTYP=TO TALTYP+AMO UNT
  1404   "RTN","RCR JRCOR",110 ,0)
  1405    .   .   .    .   S T OTAL=TOTAL +AMOUNT
  1406   "RTN","RCR JRCOR",111 ,0)
  1407    .   .   .    ;
  1408   "RTN","RCR JRCOR",112 ,0)
  1409    .   .   .    N RCFUN D S RCFUND =$S($E(DAT EEND,2,5)< "0410":$E( FUND,1,4)_ "."_$E(FUN
  1410   D,6),1:$E( FUND,1,4)_ "0"_$E(FUN D,6))
  1411   "RTN","RCR JRCOR",113 ,0)
  1412    .   .   .    I TYPE= 37 D SET($ E("             Sub-T otal by Fu nd "_RCFUN D_":"_SPAC
  1413   E,1,38)_$J (TOTALFUN, 12,2))
  1414   "RTN","RCR JRCOR",114 ,0)
  1415    .   .   ;
  1416   "RTN","RCR JRCOR",115 ,0)
  1417    .   .   D  SET("                                                                      
  1418       ------ ----")
  1419   "RTN","RCR JRCOR",116 ,0)
  1420    .   .   D  SET("                                                         TO TAL TYPE "
  1421   _TYPE_$J(T OTALTYP,13 ,2))
  1422   "RTN","RCR JRCOR",117 ,0)
  1423    .   .   D  SET(" ")
  1424   "RTN","RCR JRCOR",118 ,0)
  1425    .   D SET ("                                                                          
  1426   ---------- ")
  1427   "RTN","RCR JRCOR",119 ,0)
  1428    .   D SET ("                                                              T OTAL WR"_$
  1429   J(TOTAL,13 ,2))
  1430   "RTN","RCR JRCOR",120 ,0)
  1431    .   D SET (" ")
  1432   "RTN","RCR JRCOR",121 ,0)
  1433    ;
  1434   "RTN","RCR JRCOR",122 ,0)
  1435    I '$G(RCR JFTR) D
  1436   "RTN","RCR JRCOR",123 ,0)
  1437    .   D SET ("FMS, TRA NSFER FROM  MCCF TO H SIF (TR) D OCUMENT")
  1438   "RTN","RCR JRCOR",124 ,0)
  1439    .   D SET ("-------- ---------- ---------- ---------- ---------- -")
  1440   "RTN","RCR JRCOR",125 ,0)
  1441    .   D SET ("The foll owing data  has been  transmitte d to FMS i n the TR d ocument:")
  1442   "RTN","RCR JRCOR",126 ,0)
  1443    .   D SET ("  From F und    Fro m RSC        To Fund     To RSC                       
  1444       Amount ")
  1445   "RTN","RCR JRCOR",127 ,0)
  1446    .   D SET ("  ------ ---    --- -----        -------     ------                       
  1447   ---------- ")
  1448   "RTN","RCR JRCOR",128 ,0)
  1449    .   I $O( RCTRANS("" ))="" D SE T("  No Do llars to T ransfer.")  Q
  1450   "RTN","RCR JRCOR",129 ,0)
  1451    .   ;
  1452   "RTN","RCR JRCOR",130 ,0)
  1453    .   S FUN D="" F  S  FUND=$O(RC TRANS(FUND )) Q:FUND= ""  D
  1454   "RTN","RCR JRCOR",131 ,0)
  1455    .   .   S  RSC="" F   S RSC=$O( RCTRANS(FU ND,RSC)) Q :RSC=""  D
  1456   "RTN","RCR JRCOR",132 ,0)
  1457    .   .   .    ;  rctr ans(fromfu nd,fromrsc ) = tofund  ^ torsc ^  amount
  1458   "RTN","RCR JRCOR",133 ,0)
  1459    .   .   .    S AMOUN T=RCTRANS( FUND,RSC)
  1460   "RTN","RCR JRCOR",134 ,0)
  1461    .   .   .    D SET($ J(FUND,11) _$J(RSC,12 )_$J($P(AM OUNT,"^"), 14)_$J($P( AMOUNT,"^"
  1462   ,2),10)_$J ($P(AMOUNT ,"^",3),31 ,2))
  1463   "RTN","RCR JRCOR",135 ,0)
  1464    ;
  1465   "RTN","RCR JRCOR",136 ,0)
  1466    S XMY("G. RC AR DATA  COLLECTOR ")=""
  1467   "RTN","RCR JRCOR",137 ,0)
  1468    S %=$$SEN DMSG("AR D ata Collec tor for "_ DATEMOYR_"  Station " _PRCASITE, .XMY)
  1469   "RTN","RCR JRCOR",138 ,0)
  1470    K ^TMP($J ,"RCRJRCOR MM")
  1471   "RTN","RCR JRCOR",139 ,0)
  1472    ;
  1473   "RTN","RCR JRCOR",140 ,0)
  1474    ;  send u sers detai l report
  1475   "RTN","RCR JRCOR",141 ,0)
  1476    ;D USERRE PT^RCRJRCO U(DATEMOYR )  ;remove d from bac kround job  p315 (FY1 6 HAPE RRE
  1477     PRCA*4.5 *315)
  1478   "RTN","RCR JRCOR",142 ,0)
  1479    Q
  1480   "RTN","RCR JRCOR",143 ,0)
  1481    ;
  1482   "RTN","RCR JRCOR",144 ,0)
  1483    ;
  1484   "RTN","RCR JRCOR",145 ,0)
  1485   NDB(PRCASI TE,DATEBEG ,DATEEND)  ;  send da ta to the  national d atabase
  1486   "RTN","RCR JRCOR",146 ,0)
  1487    N %,BATCN AME,COUNT, CRITERIA,D ATA,LINE,X MY,X,Y
  1488   "RTN","RCR JRCOR",147 ,0)
  1489    K ^TMP($J ,"RCRJRCOR MM")
  1490   "RTN","RCR JRCOR",148 ,0)
  1491    S LINE=2, DATA="D$ "
  1492   "RTN","RCR JRCOR",149 ,0)
  1493    S CRITERI A="" F COU NT=1:1 S C RITERIA=$O (^TMP($J," RCRJRCOLND B",CRITERI A)) Q:CRIT
  1494   ERIA=""  D
  1495   "RTN","RCR JRCOR",150 ,0)
  1496    .   S DAT A=DATA_":" _COUNT_"/" _CRITERIA_ "/"_^TMP($ J,"RCRJRCO LNDB",CRIT ERIA)
  1497   "RTN","RCR JRCOR",151 ,0)
  1498    .   I $L( DATA)>200  D SET(DATA ) S DATA=" D$ "
  1499   "RTN","RCR JRCOR",152 ,0)
  1500    I DATA'=" D$ " D SET (DATA)
  1501   "RTN","RCR JRCOR",153 ,0)
  1502    ;
  1503   "RTN","RCR JRCOR",154 ,0)
  1504    ;  build  the first  two contro l lines in  mail mess age
  1505   "RTN","RCR JRCOR",155 ,0)
  1506    S Y=DATEB EG D DD^%D T
  1507   "RTN","RCR JRCOR",156 ,0)
  1508    S BATCNAM E="AR1-"_$ E(Y,1,3)_$ E(DATEBEG, 6,7)_$TR($ P(Y,",",2) ," ")
  1509   "RTN","RCR JRCOR",157 ,0)
  1510    S Y=DATEE ND D DD^%D T
  1511   "RTN","RCR JRCOR",158 ,0)
  1512    S BATCNAM E=BATCNAME _"-"_$E(Y, 1,3)_$E(DA TEEND,6,7) _$TR($P(Y, ",",2)," " )
  1513   "RTN","RCR JRCOR",159 ,0)
  1514    S ^TMP($J ,"RCRJRCOR MM",1)="T$  "_PRCASIT E_"$"_BATC NAME_"$$$$ $*"
  1515   "RTN","RCR JRCOR",160 ,0)
  1516    ;  get en d time (in  %)
  1517   "RTN","RCR JRCOR",161 ,0)
  1518    D NOW^%DT C
  1519   "RTN","RCR JRCOR",162 ,0)
  1520    S ^TMP($J ,"RCRJRCOR MM",2)="S$  "_STRTTIM E_"^"_%_"$ 0$"_(COUNT -1)
  1521   "RTN","RCR JRCOR",163 ,0)
  1522    ;
  1523   "RTN","RCR JRCOR",164 ,0)
  1524    S XMY("S. PRQN DATA  COLLECTION   D N S @
D NS        URL          ")=""
  1525   "RTN","RCR JRCOR",165 ,0)
  1526    S %=$$SEN DMSG("AR1  "_$E(DATEE ND,4,5)_"/ "_$E(DATEE ND,2,3)_"  NDB DATA F OR SITE "_
  1527   PRCASITE,. XMY)
  1528   "RTN","RCR JRCOR",166 ,0)
  1529    K ^TMP($J ,"RCRJRCOR MM")
  1530   "RTN","RCR JRCOR",167 ,0)
  1531    Q
  1532   "RTN","RCR JRCOR",168 ,0)
  1533    ;
  1534   "RTN","RCR JRCOR",169 ,0)
  1535    ;
  1536   "RTN","RCR JRCOR",170 ,0)
  1537   SUMMARY ;   print sum mary repor t in mailm an bulleti n
  1538   "RTN","RCR JRCOR",171 ,0)
  1539    N %,BILLD A,CRITER2, CRITERIA,D ATA0,DFN,L INE,STAT,T OTAL,VA,XM Y
  1540   "RTN","RCR JRCOR",172 ,0)
  1541    K ^TMP($J ,"RCRJRCOR ")   ; use d to ident ify test p atients
  1542   "RTN","RCR JRCOR",173 ,0)
  1543    K ^TMP($J ,"RCRJRCOR MM") ; use d to build  mailman m essage
  1544   "RTN","RCR JRCOR",174 ,0)
  1545    ;
  1546   "RTN","RCR JRCOR",175 ,0)
  1547    ;  print  any test p atient bil ls which h ave not be en closed
  1548   "RTN","RCR JRCOR",176 ,0)
  1549    S BILLDA= 0 F  S BIL LDA=$O(^TM P($J,"RCRJ RCOL","CRI T2",1,BILL DA)) Q:'BI LLDA  I $D
  1550   (^(BILLDA, 1)) D
  1551   "RTN","RCR JRCOR",177 ,0)
  1552    .   S DAT A0=$G(^PRC A(430,BILL DA,0)),STA T=$P(DATA0 ,"^",8)
  1553   "RTN","RCR JRCOR",178 ,0)
  1554    .   I STA T'=16,STAT ='42 Q  ;  bill not c urrently o pen
  1555   "RTN","RCR JRCOR",179 ,0)
  1556    .   S DFN =+$P(DATA0 ,"^",7) I  'DFN Q
  1557   "RTN","RCR JRCOR",180 ,0)
  1558    .   D PID ^VADPT
  1559   "RTN","RCR JRCOR",181 ,0)
  1560    .   I $E( $TR($G(VA( "PID")),"- "),1,5)="0 0000" S ^T MP($J,"RCR JRCOR","TE ST",BILLDA
  1561   )=""
  1562   "RTN","RCR JRCOR",182 ,0)
  1563    ;
  1564   "RTN","RCR JRCOR",183 ,0)
  1565    I '$D(^TM P($J,"RCRJ RCOR","TES T")) Q
  1566   "RTN","RCR JRCOR",184 ,0)
  1567    ;
  1568   "RTN","RCR JRCOR",185 ,0)
  1569    ;  print  data
  1570   "RTN","RCR JRCOR",186 ,0)
  1571    S LINE=0
  1572   "RTN","RCR JRCOR",187 ,0)
  1573    D SET(" " )
  1574   "RTN","RCR JRCOR",188 ,0)
  1575    D SET("Th e followin g bills ar e active a nd linked  to test pa tients:")
  1576   "RTN","RCR JRCOR",189 ,0)
  1577    S BILLDA= 0 F  S BIL LDA=$O(^TM P($J,"RCRJ RCOR","TES T",BILLDA) ) Q:'BILLD A  D SET("
  1578     "_$P($G( ^PRCA(430, BILLDA,0)) ,"^")_" (# ",BILLDA_" )")
  1579   "RTN","RCR JRCOR",190 ,0)
  1580    ;
  1581   "RTN","RCR JRCOR",191 ,0)
  1582    S XMY("G. RC AR DATA  COLLECTOR ")=""
  1583   "RTN","RCR JRCOR",192 ,0)
  1584    S %=$$SEN DMSG("MCCR  DATA COLL ECTOR INFO RMATION",. XMY)
  1585   "RTN","RCR JRCOR",193 ,0)
  1586    K ^TMP($J ,"RCRJRCOR ")
  1587   "RTN","RCR JRCOR",194 ,0)
  1588    K ^TMP($J ,"RCRJRCOR MM")
  1589   "RTN","RCR JRCOR",195 ,0)
  1590    Q
  1591   "RTN","RCR JRCOR",196 ,0)
  1592    ;
  1593   "RTN","RCR JRCOR",197 ,0)
  1594    ;
  1595   "RTN","RCR JRCOR",198 ,0)
  1596   SET(DATA)           ;   store re port
  1597   "RTN","RCR JRCOR",199 ,0)
  1598    S LINE=LI NE+1,^TMP( $J,"RCRJRC ORMM",LINE )=DATA
  1599   "RTN","RCR JRCOR",200 ,0)
  1600    Q
  1601   "RTN","RCR JRCOR",201 ,0)
  1602    ;
  1603   "RTN","RCR JRCOR",202 ,0)
  1604    ;
  1605   "RTN","RCR JRCOR",203 ,0)
  1606   SENDMSG(XM SUB,XMY) ;   send mes sage with  subject an d recipien ts
  1607   "RTN","RCR JRCOR",204 ,0)
  1608    N %X,D0,D 1,D2,DIC,D ICR,DIW,X, XCNP,XMDIS PI,XMDUN,X MDUZ,XMTEX T,XMZ,ZTPA R
  1609   "RTN","RCR JRCOR",205 ,0)
  1610    S XMDUZ=" AR PACKAGE ",XMTEXT=" ^TMP($J,"" RCRJRCORMM "","
  1611   "RTN","RCR JRCOR",206 ,0)
  1612    D ^XMD
  1613   "RTN","RCR JRCOR",207 ,0)
  1614    Q +$G(XMZ )
  1615   "RTN","RCR JRCOU")
  1616   0^5^B31169 505
  1617   "RTN","RCR JRCOU",1,0 )
  1618   RCRJRCOU ; WISC/RFJ-a r data col lector sum mary repor t ;1 Mar 9 7
  1619   "RTN","RCR JRCOU",2,0 )
  1620    ;;4.5;Acc ounts Rece ivable;**1 03**;Mar 2 0, 1995;Bu ild 1
  1621   "RTN","RCR JRCOU",3,0 )
  1622    ;;Per VHA  Directive  10-93-142 , this rou tine shoul d not be m odified.
  1623   "RTN","RCR JRCOU",4,0 )
  1624    Q
  1625   "RTN","RCR JRCOU",5,0 )
  1626    ;
  1627   "RTN","RCR JRCOU",6,0 )
  1628    ;ARDC det ailed repo rt - Modif ied to pri nt directl y as per H APE FY16 R RE - PRCA*
  1629   4.5*315
  1630   "RTN","RCR JRCOU",7,0 )
  1631    ;  This i s routine  no longer  generates  a MailMan  message!
  1632   "RTN","RCR JRCOU",8,0 )
  1633    ; Called  by VistA O ption - PR CA ARDC RE PORT        (ARDC Det ail Report )
  1634   "RTN","RCR JRCOU",9,0 )
  1635    ;
  1636   "RTN","RCR JRCOU",10, 0)
  1637   START ;  E ntry point  from the  Option
  1638   "RTN","RCR JRCOU",11, 0)
  1639    N VAUTSTR ,VAUTB,VAU TNALL,VAUT NI,DIC,Y,S CREEN
  1640   "RTN","RCR JRCOU",12, 0)
  1641    ;
  1642   "RTN","RCR JRCOU",13, 0)
  1643    W !!,"ARD C Detail R eport, ple ase select  the statu s desired  below",!!
  1644   "RTN","RCR JRCOU",14, 0)
  1645    S SCREEN= "^16^18^32 ^38^40^42^ ",DIC="^PR CA(430.3," ,VAUTNI=2, VAUTSTR="S tatus",VAU
  1646   TVB="VAUTC ",DIC("S") ="I SCREEN [(U_Y_U)"  D FIRST^VA UTOMA
  1647   "RTN","RCR JRCOU",15, 0)
  1648    I VAUTC=1  F I=2:1:7  S VAUTC($ P(SCREEN,U ,I))=$P(^P RCA(430.3, $P(SCREEN, U,I),0),U)
  1649     ;set arr ay equal t o the scre en if ALL  was select ed
  1650   "RTN","RCR JRCOU",16, 0)
  1651    Q:'$D(VAU TC)
  1652   "RTN","RCR JRCOU",17, 0)
  1653    W !!,"Thi s report r equires 13 2 columns. ",!
  1654   "RTN","RCR JRCOU",18, 0)
  1655    W ! S %ZI S="Q" D ^% ZIS I POP  Q
  1656   "RTN","RCR JRCOU",19, 0)
  1657    I $D(IO(" Q")) D  D  ^%ZTLOAD W :$D(ZTSK)  !,*7,"REQU EST QUEUED ",!,"Task  #: ",$G(ZT
  1658   SK) K ZTDE SC,ZTIO,ZT RTN,ZTSAVE  G EXIT
  1659   "RTN","RCR JRCOU",20, 0)
  1660    .S ZTDESC ="ARDC Det ail Report ",ZTRTN="D Q^RCRJRCOU "
  1661   "RTN","RCR JRCOU",21, 0)
  1662    .S ZTSAVE ("VAUTC")= ""
  1663   "RTN","RCR JRCOU",22, 0)
  1664    .S ZTSAVE ("RCRET")= "",ZTSAVE( "ZTREQ")=" @"
  1665   "RTN","RCR JRCOU",23, 0)
  1666    W !!,"<*>  please wa it <*>"
  1667   "RTN","RCR JRCOU",24, 0)
  1668    ;
  1669   "RTN","RCR JRCOU",25, 0)
  1670   DQ ;  gene rate user  detailed r eport
  1671   "RTN","RCR JRCOU",26, 0)
  1672    N DATEEND ,DATE,BILL DA,DATA,RC LINE,RCSPA CE,REPTDAT A,Y,RCBILL N,RCDTAC,R CCAT,RCSTA
  1673   T,TRANTYP, RCTOT,RCPR IN,RCRSC,R CBILL,PRCA SITE
  1674   "RTN","RCR JRCOU",27, 0)
  1675    N STAT,BI LLDA,RCRSC ,DATA7,REC ORD,RCBAL, ARACTDT,DA TEMOYR,MRA TYPE,POP,R CFUND,RCOT
  1676   HER,TYPE
  1677   "RTN","RCR JRCOU",28, 0)
  1678    ;
  1679   "RTN","RCR JRCOU",29, 0)
  1680    S DATEEND =$$LDATE^R CRJR(DT),D ATEMOYR=$E (DATEEND,1 ,5)_"00"
  1681   "RTN","RCR JRCOU",30, 0)
  1682    S DATE=0
  1683   "RTN","RCR JRCOU",31, 0)
  1684    S PRCASIT E=$$SITE^R CMSITE
  1685   "RTN","RCR JRCOU",32, 0)
  1686    S RCRET=$ NA(^TMP($J ,"RCRJRCOU ")) K @RCR ET   ;TEMP  GLOBAL FO R REPORT
  1687   "RTN","RCR JRCOU",33, 0)
  1688    ; 
  1689   "RTN","RCR JRCOU",34, 0)
  1690    S (RCLINE ,STAT)=0 F   S STAT=$ O(VAUTC(ST AT)) Q:'ST AT  D
  1691   "RTN","RCR JRCOU",35, 0)
  1692    . F  S DA TE=$O(^PRC A(430,"ASD T",STAT,DA TE)) Q:'DA TE  D
  1693   "RTN","RCR JRCOU",36, 0)
  1694    .. S BILL DA=0 F  S  BILLDA=$O( ^PRCA(430, "ASDT",STA T,DATE,BIL LDA)) Q:'B ILLDA  D
  1695   "RTN","RCR JRCOU",37, 0)
  1696    ... I $$A CCK^PRCAAC C(BILLDA), $P($G(^PRC A(430,BILL DA,0)),"^" ,2)'=26 D    ;from CU
  1697   RRENT^RCRJ RCOC 
  1698   "RTN","RCR JRCOU",38, 0)
  1699    .... S DA TA=$G(^PRC A(430,BILL DA,0)) Q:' DATA
  1700   "RTN","RCR JRCOU",39, 0)
  1701    .... S (T YPE,TRANTY P,RCRSC,RC FUND,RCPRI N)="",RCBA L=0
  1702   "RTN","RCR JRCOU",40, 0)
  1703    .... ;  b ill number
  1704   "RTN","RCR JRCOU",41, 0)
  1705    .... S RC BILLN=$P($ P(DATA,"^" ),"-",2)
  1706   "RTN","RCR JRCOU",42, 0)
  1707    .... ;  d ate activa ted
  1708   "RTN","RCR JRCOU",43, 0)
  1709    .... S RC DTAC=$$FMT E^XLFDT(DA TE,2)
  1710   "RTN","RCR JRCOU",44, 0)
  1711    .... ;  c ategory
  1712   "RTN","RCR JRCOU",45, 0)
  1713    .... S RC CAT=$E($P( $G(^PRCA(4 30.2,+$P(D ATA,"^",2) ,0)),"^"), 1,18)
  1714   "RTN","RCR JRCOU",46, 0)
  1715    .... ;  s tatus
  1716   "RTN","RCR JRCOU",47, 0)
  1717    .... S RC STAT=$E($P ($G(^PRCA( 430.3,+$P( DATA,"^",8 ),0)),"^") ,1,15)
  1718   "RTN","RCR JRCOU",48, 0)
  1719    .... S RE PTDATA=$$B ILLBAL^RCR JRCOB(BILL DA,DATEEND )  ;  find s a bills  balance an
  1720   d age - (a s per HDR^ RCDPTPLM)
  1721   "RTN","RCR JRCOU",49, 0)
  1722    .... S TY PE="SV21"  I $$ACCK^P RCAACC(BIL LDA) S RCR SC=$$CALCR SC^RCXFMSU R(BILLDA) 
  1723   ;                       (as per  CURRENT^RC RJRCOC)
  1724   "RTN","RCR JRCOU",50, 0)
  1725    .... I $E (RCRSC,1,2 )=86!($E(R CRSC,1,2)= "8S") S TY PE="2A"
  1726   "RTN","RCR JRCOU",51, 0)
  1727    .... ;  G et AR Date  Active fo r bill
  1728   "RTN","RCR JRCOU",52, 0)
  1729    .... S AR ACTDT=+$P( $P($G(^PRC A(430,BILL DA,6)),"^" ,21),".")   ;                   
  1730           (a s per STAR T^RCRJRBD)
  1731   "RTN","RCR JRCOU",53, 0)
  1732    ....  ;   determine  Receivable  Type: 1=p re-MRA, 2= post-MRA M edicre, 3= post-MRA n
  1733   on-Medicar e
  1734   "RTN","RCR JRCOU",54, 0)
  1735     .... ;   fms report  type - TR ANTYP vari able
  1736   "RTN","RCR JRCOU",55, 0)
  1737    .... S MR ATYPE=$$MR ATYPE^IBCE MU2(BILLDA ,ARACTDT)  ;                               
  1738           (a s per CURR ENT^RCRJRC OC)
  1739   "RTN","RCR JRCOU",56, 0)
  1740    .... ;  s et TYPE to  2F for po st-MRA Med icare bill s or to 2L  for post- MRA non-Me
  1741   dicare bil ls (for RH I receivab les only)
  1742   "RTN","RCR JRCOU",57, 0)
  1743    .... I $E (RCRSC,1,2 )=85!($E(R CRSC,1,2)= "8R"),MRAT YPE>1 S TY PE=$S(MRAT YPE=2:"2F"
  1744   ,1:"2L")
  1745   "RTN","RCR JRCOU",58, 0)
  1746    .... I $E (RCRSC,1,2 )=86!($E(R CRSC,1,2)= "8S") S TY PE="SV21"
  1747   "RTN","RCR JRCOU",59, 0)
  1748    .... S TR ANTYP=$G(T YPE)
  1749   "RTN","RCR JRCOU",60, 0)
  1750    ....  ;   calculate  principal  and other  (int + adm in) balanc e  - calcu lations   
  1751           (a s per NONM CCF^RCRJRO IG)
  1752   "RTN","RCR JRCOU",61, 0)
  1753    .... S DA TA7="",DAT A7=$G(^PRC A(430,BILL DA,7))
  1754   "RTN","RCR JRCOU",62, 0)
  1755    .... S RC PRIN=+$P(D ATA7,"^")
  1756   "RTN","RCR JRCOU",63, 0)
  1757    .... S RC OTHER=$P(D ATA7,"^",2 )+$P(DATA7 ,"^",3)+$P (DATA7,"^" ,4)+$P(DAT A7,"^",5)
  1758   "RTN","RCR JRCOU",64, 0)
  1759    ....   ;   in some b ills, the  principal  and other  balance ma y cancel
  1760   "RTN","RCR JRCOU",65, 0)
  1761    ....   ;   each othe r.  for ex ample prin cipal .08  + interest  -.08 = 0
  1762   "RTN","RCR JRCOU",66, 0)
  1763    .... I (R CPRIN+RCOT HER)'>0 S  RCPRIN=0
  1764   "RTN","RCR JRCOU",67, 0)
  1765    .... ;  t otal
  1766   "RTN","RCR JRCOU",68, 0)
  1767    .... S RC TOT=$P(REP TDATA,"^") +$P(REPTDA TA,"^",2)
  1768   "RTN","RCR JRCOU",69, 0)
  1769    .... ; Ba lance=Tota l-Principa l  (quit i f zero)
  1770   "RTN","RCR JRCOU",70, 0)
  1771    .... S RC BAL=RCTOT- RCPRIN Q:R CBAL<1  ;Q uit with t here is no  balance d ue
  1772   "RTN","RCR JRCOU",71, 0)
  1773    .... S RC PRIN=$J(RC PRIN,11,2) ,RCBAL=$J( RCBAL,11,2 )
  1774   "RTN","RCR JRCOU",72, 0)
  1775    .... ;Rev enue Servi ce Code  
  1776   "RTN","RCR JRCOU",73, 0)
  1777    .... S RC RSC="" I $ $ACCK^PRCA ACC(BILLDA ) S RCRSC= $$CALCRSC^ RCXFMSUR(B ILLDA) ;  
  1778           (a s per CURR ENT^RCRJRC OC)
  1779   "RTN","RCR JRCOU",74, 0)
  1780    .... ;Fun d
  1781   "RTN","RCR JRCOU",75, 0)
  1782    .... S RC FUND=$$GET FUNDB^RCXF MSUF(BILLD A,1)
  1783   "RTN","RCR JRCOU",76, 0)
  1784    .... S RC LINE=RCLIN E+1  ;(rec ord counte r)
  1785   "RTN","RCR JRCOU",77, 0)
  1786    .... S @R CRET@(RCLI NE)=RCBILL N_U_RCDTAC _U_RCCAT_U _RCSTAT_U_ TRANTYP_U_ RCFUND_U_R
  1787   CRSC_U_RCP RIN_U_RCBA L
  1788   "RTN","RCR JRCOU",78, 0)
  1789    ; end of  gathering  data
  1790   "RTN","RCR JRCOU",79, 0)
  1791    ;
  1792   "RTN","RCR JRCOU",80, 0)
  1793    I RCLINE= 0 S PAGE=1  D HDR W ! !!,"The re port found  no patien ts with a  balance du
  1794   e for this  report" G  EXIT
  1795   "RTN","RCR JRCOU",81, 0)
  1796    ;
  1797   "RTN","RCR JRCOU",82, 0)
  1798    D PRINT
  1799   "RTN","RCR JRCOU",83, 0)
  1800    ;
  1801   "RTN","RCR JRCOU",84, 0)
  1802   EXIT ;comm om exit po int
  1803   "RTN","RCR JRCOU",85, 0)
  1804    D ^%ZISC
  1805   "RTN","RCR JRCOU",86, 0)
  1806    K ^TMP($J ,"RCRJRCOU ")
  1807   "RTN","RCR JRCOU",87, 0)
  1808    Q
  1809   "RTN","RCR JRCOU",88, 0)
  1810    ;
  1811   "RTN","RCR JRCOU",89, 0)
  1812   HDR ;Set t he header
  1813   "RTN","RCR JRCOU",90, 0)
  1814    ;
  1815   "RTN","RCR JRCOU",91, 0)
  1816    S PAGE=PA GE+1 U IO  W @IOF
  1817   "RTN","RCR JRCOU",92, 0)
  1818    W ?50,"AR DC Detaile d Report", ?105,"Page :",PAGE,!
  1819   "RTN","RCR JRCOU",93, 0)
  1820    W "Bill#" ,?12,"AR C reate",?25 ,"AR Categ ory",?45,"  Bill",?62 ,"FMS",?71 ," Fund",?
  1821   82,"RSC",? 92,"Princi pal",?110, "Balance"
  1822   "RTN","RCR JRCOU",94, 0)
  1823    W !,?14,"  Date",?45 ,"Status", ?61,"Type" ,?71,"Numb er",?95,"A mount",!
  1824   "RTN","RCR JRCOU",95, 0)
  1825    N I F I=1 :1:120 W " -"
  1826   "RTN","RCR JRCOU",96, 0)
  1827    Q
  1828   "RTN","RCR JRCOU",97, 0)
  1829    ;
  1830   "RTN","RCR JRCOU",98, 0)
  1831   PRINT ; pr int record s to scree n or print er 132 col umns
  1832   "RTN","RCR JRCOU",99, 0)
  1833    N PAGE S  PAGE=0,REC ORD=0
  1834   "RTN","RCR JRCOU",100 ,0)
  1835    F  S RECO RD=$O(@RCR ET@(RECORD )) Q:'RECO RD  D
  1836   "RTN","RCR JRCOU",101 ,0)
  1837    . I RECOR D=1 D HDR
  1838   "RTN","RCR JRCOU",102 ,0)
  1839    . I $Y+3> IOSL I ($E (IOST,1,2) ="C-")&(IO =IO(0)) S  DIR(0)="E"  D ^DIR K  DIR G:$D(D
  1840   UOUT)!($D( DTOUT)) EX IT D HDR
  1841   "RTN","RCR JRCOU",103 ,0)
  1842    . W !,$P( @RCRET@(RE CORD),U),? 12,$P(@RCR ET@(RECORD ),U,2),?25 ,$P(@RCRET @(RECORD),
  1843   U,3),?45,$ P(@RCRET@( RECORD),U, 4),?62,$P( @RCRET@(RE CORD),U,5)
  1844   "RTN","RCR JRCOU",104 ,0)
  1845    . W ?72,$ P(@RCRET@( RECORD),U, 6),?82,$P( @RCRET@(RE CORD),U,7) ,?90,$P(@R CRET@(RECO
  1846   RD),U,8),? 106,$P(@RC RET@(RECOR D),U,9)
  1847   "RTN","RCR JRCOU",105 ,0)
  1848    Q
  1849   "RTN","RCR JRCOU",106 ,0)
  1850    ;
  1851   "RTN","RCR JRCOU",107 ,0)
  1852    ; Leaving  old entry  point in  place as a  precautio n
  1853   "RTN","RCR JRCOU",108 ,0)
  1854   USERREPT(D ATEMOYR) ;   generate  user deta iled repor t and send  it to Mai lMan
  1855   "RTN","RCR JRCOU",109 ,0)
  1856    Q  ;Previ ous entry  point, no  longer use d.
  1857   "RTN","RCR JRCOU",110 ,0)
  1858    ;
  1859   "RTN","RCR JRCOU",111 ,0)
  1860    ;END RCRJ RCOU
  1861   "VER")
  1862   8.0^22.0
  1863   **END**
  1864   **END**