source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPRTP.m@ 770

Last change on this file since 770 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1RCDPRTP ;ALB/LDB-CLAIMS MATCHING REPORT ;1/11/01 2:03 PM
2 ;;4.5;Accounts Receivable;**151,186**;Mar 20, 1995
3 ;
4 ;
5EN N DATEEND,DATESTRT,DIC,DIR,DIRUT,POP,RCAN,RCBILL,RCDEBT,RCDFN,RCPT,RCSORT,RCQUIT,%ZIS,ZTDESC,ZTSAVE,ZTRTN,Y
6 W !
7 K DIRUT S DIR(0)="S^1:Patient;2:Bill Number;3:Payment dates;4:Receipt Number",DIR("A")="Sort by" D ^DIR K DIR Q:$D(DIRUT)
8 S RCSORT=Y,RCQUIT=""
9 D @RCSORT Q:RCQUIT W !
10 K DIRUT S DIR(0)="Y",DIR("A")="Include cancelled bills",DIR("B")="NO" D ^DIR S RCAN=+Y Q:$D(DIRUT)
11 ;
12 ; select device
13 W !!,"This report requires 132 columns.",!
14 W ! S %ZIS="Q" D ^%ZIS I POP Q
15 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
16 .S ZTDESC="Claims Matching Report",ZTRTN="DQ^RCDPRTP"
17 .S ZTSAVE("RCSORT")=""
18 .I RCSORT=1 S ZTSAVE("RCDEBT")="",ZTSAVE("RCDFN")="",ZTSAVE("DATE*")=""
19 .I RCSORT=2 S ZTSAVE("RCBILL")="",ZTSAVE("RCDFN")="",ZTSAVE("RCDEBT")=""
20 .I RCSORT=3 S ZTSAVE("DATE*")=""
21 .I RCSORT=4 S ZTSAVE("RCPT")=""
22 .S ZTSAVE("RCAN")="",ZTSAVE("ZTREQ")="@"
23 W !!,"<*> please wait <*>"
24 ;
25DQ ; queued report starts here
26 U IO
27 K ^TMP("RCDPRTPB",$J)
28 K ^TMP("IBRBT",$J)
29 K ^TMP("IBRBF",$J)
30 N DAT,RCBIL,RCBIL0,RCNAM,RCPAY,RCPAY1,RCREC,RCREC1,RCRECTDA,RCSSN,RCTYP
31 D @($S(RCSORT=1:"PAT",RCSORT=2:"BILL",RCSORT=3:"DATE",1:"REC")_"^RCDPRTP0")
32 D EN^RCDPRTP1
33 K DATESTRT,DATEEND,^TMP("RCDPRTPB",$J)
34 D ^%ZISC
35 Q
36 ;
37 ;
381 S DIC(0)="QEAMZ",DIC=340,DIC("S")="I ^RCD(340,+Y,0)[""DPT""",DIC("A")="Patient name: " D ^DIC I Y<0 S RCQUIT=1 Q
39 S RCDEBT=+Y,RCDFN=+$P(Y,"^",2)
40 D DATESEL^RCRJRTRA("Payment")
41 I '$G(DATESTRT)!('$G(DATEEND)) S RCQUIT=1
42 Q
43 ;
443 D DATESEL^RCRJRTRA("Payment")
45 I '$G(DATESTRT)!('$G(DATEEND)) S RCQUIT=1
46 Q
47 ;
482 N DIC,DUOUT
49 K ^TMP("IBRBF",$J)
50 S DIC(0)="QEAM",DIC=430,DIC("S")="I $P(^(0),U,2)=9" D ^DIC I Y<0 S RCQUIT=1 Q
51 S RCBILL=+Y,RCDFN=$P($G(^PRCA(430,+RCBILL,0)),"^",7) Q:'RCDFN
52 S RCDEBT=$O(^RCD(340,"B",RCDFN_";DPT(",0))
53 I (RCDFN="")!(RCDEBT="") W !,"This bill has no matching first party bills." G 2
54 D RELBILL^IBRFN(RCBILL)
55 I '$O(^TMP("IBRBF",$J,RCBILL,0)) W !,"This bill has no matching first party debts." K ^TMP("IBRBF",$J) G 2
56 K ^TMP("IBRBF",$J)
57 Q
58 ;
594 N DIC,X,Y
60 S DIC(0)="QEAM",DIC=344 D ^DIC I Y<0 S RCQUIT=1 Q
61 S RCPT=$P(Y,"^",2)
62 Q
Note: See TracBrowser for help on using the repository browser.