source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCKATRPT.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1RCKATRPT ;ALB/MAF-KATRINA FINANCIAL STATEMENT REPORT ;12/1/05 4:14 PM
2V ;;4.5;Accounts Receivable;**242,246**;Mar 20, 1995
3 ;
4EN1 ;
5 N RCTYPE,X,%,DUOUT,DTOUT,DIR,RCDATE,Y
6 S DIR("A")="(S)UMMARY OR (D)ETAIL?: ",DIR(0)="SBA^S:SUMMARY TOTALS ONLY;D:DETAILS AND SUMMARY"
7 S DIR("B")="S" D ^DIR K DIR
8 I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
9 S RCTYPE=Y
10 D NOW^%DTC
11 S RCDATE=DT
12 ; Ask device
13 N ZTRTN,ZTSK,ZTSAVE,ZTDESC,%ZIS,POP
14 S %ZIS="QM" D ^%ZIS G:POP RPTQ
15 I $D(IO("Q")) D G RPTQ
16 . S ZTRTN="EN^RCKATRPT",ZTSAVE("RCTYPE")="",ZTSAVE("RCDATE")="",ZTDESC="KATRINA REPORT"
17 . D ^%ZTLOAD
18 . W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unavailable")
19 . K ZTSK,IO("Q") D HOME^%ZIS
20 U IO
21 D EN^RCKATRPT
22RPTQ Q
23EN ;
24 N BBAL,DEB,RCDFN,X,SITE,Y,%,%H,%I,RCSITE,DFN,BN,RCDCL,RCDL,RCPAG,STAT,TOTAMT,TOTVET,BAL,DATA,INT,RCTOT,AC,OP,PRE,ADM,PB,RCFLAG,X1,X2
25 K ^XTMP("RCKATRPT")
26 D NOW^%DTC S X1=DT,X2=30 D C^%DTC
27 S ^XTMP("RCKATRPT",0)=DT_"^"_X_"^Katrina Detailed Report"
28 S (DEB,TOTAMT,TOTVET)=0
29 K ^TMP("RCDEBTOR",$J),^TMP("RCTOT",$J),^TMP("DEBTOR",$J),^TMP("RCSITE",$J),^TMP("RCDFN",$J),^TMP("RCBBL",$J)
30 F S DEB=$O(^RCD(340,"AB","DPT(",DEB)) Q:DEB="" D
31 . I $L(+$$SSN^RCFN01(DEB))<5 Q
32 . ;Check for Emergency Response Indicator (ERI) Flag.
33 . ;N RCDFN S RCDFN=$P($G(^RCD(340,DEB,0)),"^",1) I $$EMERES^PRCAUTL(+RCDFN)']"" Q
34 . N RCDFN S RCDFN=$P($G(^RCD(340,DEB,0)),"^",1) I $$EMGRES^DGUTL(+RCDFN)']"" Q
35 . S BBAL=0 D BBAL ;get bill bal
36 D PRINT
37 K ^TMP("RCDEBTOR",$J),^TMP("RCTOT",$J),^TMP("DEBTOR",$J),^TMP("RCSITE",$J),^TMP("RCDFN",$J),^TMP("RCBBL",$J)
38 Q
39BBAL ;get bills balances return array
40 G:'DEB BBALQ
41 S AC=+$O(^PRCA(430.3,"AC",102,0)),OP=+$O(^PRCA(430.3,"AC",112,0))
42 F STAT=AC,OP F BN=0:0 S BN=$O(^PRCA(430,"AS",DEB,STAT,BN)) Q:'BN D
43 .I '$D(^TMP("RCBBL",$J,DEB)) S (BBAL,PB,INT,ADM)=0 S ^TMP("RCBBL",$J,DEB)=""
44 .S BAL=$G(^PRCA(430,BN,7))
45 .S SITE=$S($P($G(^PRCA(430,BN,0)),"^",12):$P($G(^PRCA(430,BN,0)),"^",12),1:"SITE UNKNOWN")
46 .I '$D(^TMP("DEBTOR",$J,SITE,DEB)) S TOTVET=TOTVET+1
47 .S PB=PB+$P(BAL,"^",1),INT=INT+$P(BAL,"^",2),ADM=ADM+$P(BAL,"^",3)
48 .S BBAL=$P(BAL,"^",1)+$P(BAL,"^",2)+$P(BAL,"^",3)
49 .S ^TMP("DEBTOR",$J,SITE,DEB,+RCDFN,BN)=$P(BAL,"^",1)_"^"_$P(BAL,"^",2)_"^"_$P(BAL,"^",3)_"^"_BBAL
50 .S ^TMP("RCDEBTOR",$J,SITE,DEB,+RCDFN)=PB_"^"_INT_"^"_ADM_"^"_(PB+INT+ADM)
51 .S RCTOT=$G(^TMP("RCTOT",$J,SITE)),$P(^TMP("RCTOT",$J,SITE),"^",1)=$P(RCTOT,"^",1)+$P(BAL,"^",1),$P(^TMP("RCTOT",$J,SITE),"^",2)=$P(RCTOT,"^",2)+$P(BAL,"^",2)
52 .S $P(^TMP("RCTOT",$J,SITE),"^",3)=$P(RCTOT,"^",3)+$P(BAL,"^",3),$P(^TMP("RCTOT",$J,SITE),"^",4)=$P(RCTOT,"^",4)+BBAL
53 .Q
54BBALQ Q
55PRINT ;PRINT THE REPORT
56 S $P(RCDCL,"=",81)="",(SITE,RCPAG)=0
57 D HEAD
58 I '$D(^TMP("RCDEBTOR",$J)) W !!,"No data meets this criteria" Q
59 I RCTYPE="D" D
60 .S RCFLAG=0 F S SITE=$O(^TMP("DEBTOR",$J,SITE)) Q:SITE=""!(RCFLAG) S DEB=0 F S DEB=$O(^TMP("DEBTOR",$J,SITE,DEB)) Q:DEB=""!(RCFLAG) D
61 ..S DFN=0 F S DFN=$O(^TMP("DEBTOR",$J,SITE,DEB,DFN)) Q:DFN=""!(RCFLAG) S BN=0 F S BN=$O(^TMP("DEBTOR",$J,SITE,DEB,DFN,BN)) Q:BN=""!(RCFLAG) D:$Y+5>IOSL RET Q:RCFLAG D PRDATA
62 ..Q
63 .Q
64 I RCTYPE="D" Q:RCFLAG S RCTYPE="S" S RCPAG=0 D RET Q:RCFLAG
65 I RCTYPE="S" D
66 .F S SITE=$O(^TMP("RCTOT",$J,SITE)) Q:SITE="" D PRDATA
67 .Q
68 Q
69RET ;
70 F X=$Y:1:(IOSL-3) W !
71 I IOST'?1"C-".E D Q
72 .I RCTYPE="D" K ^TMP("RCSITE",$J,SITE),^TMP("RCDFN",$J,DFN)
73 .D HEAD
74 N DIR,DUOUT,DTOUT
75 S DIR(0)="EA",DIR("A")="Enter <RET> to continue or ^ to quit " D ^DIR
76 I $D(DTOUT)!$D(DUOUT) S RCFLAG=1 Q:RCFLAG
77 I RCTYPE="D" K ^TMP("RCSITE",$J,SITE),^TMP("RCDFN",$J,DFN)
78HEAD ;HEADING DETAILED
79 N Y S RCPAG=RCPAG+1
80 W @IOF,"Financial"_$S(RCTYPE="S":" Summary ",1:" Detailed ")_"Statement for Hurricane Katrina ",?53 S Y=RCDATE D DD^%DT W Y," ",$J("PAGE: "_RCPAG,12),!
81 I RCTYPE="S" D
82 .W !,"SITE",?25,"#AFFECTED VETS",?48,"TOTAL AMT.",?65,"AVG. AMOUNT/VET"
83 I RCTYPE="D" D
84 .W !,"BILL #",?17,"PRINC. BAL",?41,"INT.",?56,"ADM.",?75,"TOTAL"
85 W !,RCDCL
86 Q
87PRDATA ;WRITE THE DATA
88 ;W !
89 I RCTYPE="S" D
90 .S TOTAMT=$P($G(^TMP("RCTOT",$J,SITE)),"^",4)
91 .W !,$P($$SITE^VASITE(),"^",2),?20,$J(TOTVET,18),?40,$J("$"_TOTAMT,18),?60,$J("$"_$P(TOTAMT/TOTVET,".",1)_"."_$E($P(TOTAMT/TOTVET,".",2),1,2),18)
92 .S ^XTMP("RCKATRPT",SITE,"TOTGRAND")=TOTVET_"^"_TOTAMT_"^"_$P(TOTAMT/TOTVET,".",1)_"."_$E($P(TOTAMT/TOTVET,".",2),1,2)
93 I RCTYPE="D" D
94 .N DATA
95 .S DATA=$G(^TMP("DEBTOR",$J,SITE,DEB,DFN,BN))
96 . I '$D(^TMP("RCSITE",$J,SITE)) W !,?35,$P($$SITE^VASITE(),"^",2),! S ^TMP("RCSITE",$J,SITE)=""
97 . I '$D(^TMP("RCDFN",$J,DFN)) W !,DEB_":"_$P($G(^DPT(DFN,0)),"^",1) S ^TMP("RCDFN",$J,DFN)=""
98 . W !,$P($G(^PRCA(430,BN,0)),"^",1),?12,$S($P($G(DATA),"^",1):$J("$"_$P(DATA,"^",1),15),1:$J("$0",15)),?30,$S($P($G(DATA),"^",2):$J("$"_$P(DATA,"^",2),15),1:$J("$0",15))
99 .W ?45,$S($P($G(DATA),"^",3):$J("$"_$P(DATA,"^",3),15),1:$J("$0",15)),?65,$S($P($G(DATA),"^",4):$J("$"_$P(DATA,"^",4),15),1:$J("$0",15))
100 .S ^TMP("RCSITE",$J,SITE)="",^TMP("RCDFN",$J,DFN)=""
101 .I '$O(^TMP("DEBTOR",$J,SITE,DEB,DFN,BN)) D
102 ..I $Y+5>IOSL D RET Q:RCFLAG W !,?35,$P($$SITE^VASITE(),"^",2),!!,DEB_":"_$P($G(^DPT(DFN,0)),"^",1),! S ^TMP("RCSITE",$J,SITE)="",^TMP("RCDFN",$J,DFN)=""
103 ..N X
104 ..S X=$G(^TMP("RCDEBTOR",$J,SITE,DEB,DFN))
105 ..S $P(RCDL,"-",65)="" W !,"------",?16,RCDL
106 ..W !,"TOTAL: ",?12,$J("$"_$P(X,"^",1),15),?30,$J("$"_$P(X,"^",2),15),?45,$J("$"_$P(X,"^",3),15),?65,$J("$"_$P(X,"^",4),15),!
107 ..S ^XTMP("RCKATRPT",SITE,DEB,DFN,"TOT")=DEB_"^"_"^"_X
108 .S ^XTMP("RCKATRPT",SITE,DEB,DFN,BN)=DEB_"^"_BN_"^"_DATA
109 .Q
110 Q
Note: See TracBrowser for help on using the repository browser.