RCKATRPT ;ALB/MAF-KATRINA FINANCIAL STATEMENT REPORT ;12/1/05 4:14 PM
V ;;4.5;Accounts Receivable;**242,246**;Mar 20, 1995
;
EN1 ;
N RCTYPE,X,%,DUOUT,DTOUT,DIR,RCDATE,Y
S DIR("A")="(S)UMMARY OR (D)ETAIL?: ",DIR(0)="SBA^S:SUMMARY TOTALS ONLY;D:DETAILS AND SUMMARY"
S DIR("B")="S" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") G RPTQ
S RCTYPE=Y
D NOW^%DTC
S RCDATE=DT
; Ask device
N ZTRTN,ZTSK,ZTSAVE,ZTDESC,%ZIS,POP
S %ZIS="QM" D ^%ZIS G:POP RPTQ
I $D(IO("Q")) D G RPTQ
. S ZTRTN="EN^RCKATRPT",ZTSAVE("RCTYPE")="",ZTSAVE("RCDATE")="",ZTDESC="KATRINA REPORT"
. D ^%ZTLOAD
. W !!,$S($D(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unavailable")
. K ZTSK,IO("Q") D HOME^%ZIS
U IO
D EN^RCKATRPT
RPTQ Q
EN ;
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
K ^XTMP("RCKATRPT")
D NOW^%DTC S X1=DT,X2=30 D C^%DTC
S ^XTMP("RCKATRPT",0)=DT_"^"_X_"^Katrina Detailed Report"
S (DEB,TOTAMT,TOTVET)=0
K ^TMP("RCDEBTOR",$J),^TMP("RCTOT",$J),^TMP("DEBTOR",$J),^TMP("RCSITE",$J),^TMP("RCDFN",$J),^TMP("RCBBL",$J)
F S DEB=$O(^RCD(340,"AB","DPT(",DEB)) Q:DEB="" D
. I $L(+$$SSN^RCFN01(DEB))<5 Q
. ;Check for Emergency Response Indicator (ERI) Flag.
. ;N RCDFN S RCDFN=$P($G(^RCD(340,DEB,0)),"^",1) I $$EMERES^PRCAUTL(+RCDFN)']"" Q
. N RCDFN S RCDFN=$P($G(^RCD(340,DEB,0)),"^",1) I $$EMGRES^DGUTL(+RCDFN)']"" Q
. S BBAL=0 D BBAL ;get bill bal
D PRINT
K ^TMP("RCDEBTOR",$J),^TMP("RCTOT",$J),^TMP("DEBTOR",$J),^TMP("RCSITE",$J),^TMP("RCDFN",$J),^TMP("RCBBL",$J)
Q
BBAL ;get bills balances return array
G:'DEB BBALQ
S AC=+$O(^PRCA(430.3,"AC",102,0)),OP=+$O(^PRCA(430.3,"AC",112,0))
F STAT=AC,OP F BN=0:0 S BN=$O(^PRCA(430,"AS",DEB,STAT,BN)) Q:'BN D
.I '$D(^TMP("RCBBL",$J,DEB)) S (BBAL,PB,INT,ADM)=0 S ^TMP("RCBBL",$J,DEB)=""
.S BAL=$G(^PRCA(430,BN,7))
.S SITE=$S($P($G(^PRCA(430,BN,0)),"^",12):$P($G(^PRCA(430,BN,0)),"^",12),1:"SITE UNKNOWN")
.I '$D(^TMP("DEBTOR",$J,SITE,DEB)) S TOTVET=TOTVET+1
.S PB=PB+$P(BAL,"^",1),INT=INT+$P(BAL,"^",2),ADM=ADM+$P(BAL,"^",3)
.S BBAL=$P(BAL,"^",1)+$P(BAL,"^",2)+$P(BAL,"^",3)
.S ^TMP("DEBTOR",$J,SITE,DEB,+RCDFN,BN)=$P(BAL,"^",1)_"^"_$P(BAL,"^",2)_"^"_$P(BAL,"^",3)_"^"_BBAL
.S ^TMP("RCDEBTOR",$J,SITE,DEB,+RCDFN)=PB_"^"_INT_"^"_ADM_"^"_(PB+INT+ADM)
.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)
.S $P(^TMP("RCTOT",$J,SITE),"^",3)=$P(RCTOT,"^",3)+$P(BAL,"^",3),$P(^TMP("RCTOT",$J,SITE),"^",4)=$P(RCTOT,"^",4)+BBAL
.Q
BBALQ Q
PRINT ;PRINT THE REPORT
S $P(RCDCL,"=",81)="",(SITE,RCPAG)=0
D HEAD
I '$D(^TMP("RCDEBTOR",$J)) W !!,"No data meets this criteria" Q
I RCTYPE="D" D
.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
..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
..Q
.Q
I RCTYPE="D" Q:RCFLAG S RCTYPE="S" S RCPAG=0 D RET Q:RCFLAG
I RCTYPE="S" D
.F S SITE=$O(^TMP("RCTOT",$J,SITE)) Q:SITE="" D PRDATA
.Q
Q
RET ;
F X=$Y:1:(IOSL-3) W !
I IOST'?1"C-".E D Q
.I RCTYPE="D" K ^TMP("RCSITE",$J,SITE),^TMP("RCDFN",$J,DFN)
.D HEAD
N DIR,DUOUT,DTOUT
S DIR(0)="EA",DIR("A")="Enter <RET> to continue or ^ to quit " D ^DIR
I $D(DTOUT)!$D(DUOUT) S RCFLAG=1 Q:RCFLAG
I RCTYPE="D" K ^TMP("RCSITE",$J,SITE),^TMP("RCDFN",$J,DFN)
HEAD ;HEADING DETAILED
N Y S RCPAG=RCPAG+1
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),!
I RCTYPE="S" D
.W !,"SITE",?25,"#AFFECTED VETS",?48,"TOTAL AMT.",?65,"AVG. AMOUNT/VET"
I RCTYPE="D" D
.W !,"BILL #",?17,"PRINC. BAL",?41,"INT.",?56,"ADM.",?75,"TOTAL"
W !,RCDCL
Q
PRDATA ;WRITE THE DATA
;W !
I RCTYPE="S" D
.S TOTAMT=$P($G(^TMP("RCTOT",$J,SITE)),"^",4)
.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)
.S ^XTMP("RCKATRPT",SITE,"TOTGRAND")=TOTVET_"^"_TOTAMT_"^"_$P(TOTAMT/TOTVET,".",1)_"."_$E($P(TOTAMT/TOTVET,".",2),1,2)
I RCTYPE="D" D
.N DATA
.S DATA=$G(^TMP("DEBTOR",$J,SITE,DEB,DFN,BN))
. I '$D(^TMP("RCSITE",$J,SITE)) W !,?35,$P($$SITE^VASITE(),"^",2),! S ^TMP("RCSITE",$J,SITE)=""
. I '$D(^TMP("RCDFN",$J,DFN)) W !,DEB_":"_$P($G(^DPT(DFN,0)),"^",1) S ^TMP("RCDFN",$J,DFN)=""
. 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))
.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))
.S ^TMP("RCSITE",$J,SITE)="",^TMP("RCDFN",$J,DFN)=""
.I '$O(^TMP("DEBTOR",$J,SITE,DEB,DFN,BN)) D
..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)=""
..N X
..S X=$G(^TMP("RCDEBTOR",$J,SITE,DEB,DFN))
..S $P(RCDL,"-",65)="" W !,"------",?16,RCDL
..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),!
..S ^XTMP("RCKATRPT",SITE,DEB,DFN,"TOT")=DEB_"^"_"^"_X
.S ^XTMP("RCKATRPT",SITE,DEB,DFN,BN)=DEB_"^"_BN_"^"_DATA
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCKATRPT 5566 printed Dec 13, 2024@01:47:09 Page 2
RCKATRPT ;ALB/MAF-KATRINA FINANCIAL STATEMENT REPORT ;12/1/05 4:14 PM
V ;;4.5;Accounts Receivable;**242,246**;Mar 20, 1995
+1 ;
EN1 ;
+1 NEW RCTYPE,X,%,DUOUT,DTOUT,DIR,RCDATE,Y
+2 SET DIR("A")="(S)UMMARY OR (D)ETAIL?: "
SET DIR(0)="SBA^S:SUMMARY TOTALS ONLY;D:DETAILS AND SUMMARY"
+3 SET DIR("B")="S"
DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
GOTO RPTQ
+5 SET RCTYPE=Y
+6 DO NOW^%DTC
+7 SET RCDATE=DT
+8 ; Ask device
+9 NEW ZTRTN,ZTSK,ZTSAVE,ZTDESC,%ZIS,POP
+10 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO RPTQ
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 SET ZTRTN="EN^RCKATRPT"
SET ZTSAVE("RCTYPE")=""
SET ZTSAVE("RCDATE")=""
SET ZTDESC="KATRINA REPORT"
+13 DO ^%ZTLOAD
+14 WRITE !!,$SELECT($DATA(ZTSK):"Your task number "_ZTSK_" has been queued.",1:"Unavailable")
+15 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
GOTO RPTQ
+16 USE IO
+17 DO EN^RCKATRPT
RPTQ QUIT
EN ;
+1 NEW 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
+2 KILL ^XTMP("RCKATRPT")
+3 DO NOW^%DTC
SET X1=DT
SET X2=30
DO C^%DTC
+4 SET ^XTMP("RCKATRPT",0)=DT_"^"_X_"^Katrina Detailed Report"
+5 SET (DEB,TOTAMT,TOTVET)=0
+6 KILL ^TMP("RCDEBTOR",$JOB),^TMP("RCTOT",$JOB),^TMP("DEBTOR",$JOB),^TMP("RCSITE",$JOB),^TMP("RCDFN",$JOB),^TMP("RCBBL",$JOB)
+7 FOR
SET DEB=$ORDER(^RCD(340,"AB","DPT(",DEB))
if DEB=""
QUIT
Begin DoDot:1
+8 IF $LENGTH(+$$SSN^RCFN01(DEB))<5
QUIT
+9 ;Check for Emergency Response Indicator (ERI) Flag.
+10 ;N RCDFN S RCDFN=$P($G(^RCD(340,DEB,0)),"^",1) I $$EMERES^PRCAUTL(+RCDFN)']"" Q
+11 NEW RCDFN
SET RCDFN=$PIECE($GET(^RCD(340,DEB,0)),"^",1)
IF $$EMGRES^DGUTL(+RCDFN)']""
QUIT
+12 ;get bill bal
SET BBAL=0
DO BBAL
End DoDot:1
+13 DO PRINT
+14 KILL ^TMP("RCDEBTOR",$JOB),^TMP("RCTOT",$JOB),^TMP("DEBTOR",$JOB),^TMP("RCSITE",$JOB),^TMP("RCDFN",$JOB),^TMP("RCBBL",$JOB)
+15 QUIT
BBAL ;get bills balances return array
+1 if 'DEB
GOTO BBALQ
+2 SET AC=+$ORDER(^PRCA(430.3,"AC",102,0))
SET OP=+$ORDER(^PRCA(430.3,"AC",112,0))
+3 FOR STAT=AC,OP
FOR BN=0:0
SET BN=$ORDER(^PRCA(430,"AS",DEB,STAT,BN))
if 'BN
QUIT
Begin DoDot:1
+4 IF '$DATA(^TMP("RCBBL",$JOB,DEB))
SET (BBAL,PB,INT,ADM)=0
SET ^TMP("RCBBL",$JOB,DEB)=""
+5 SET BAL=$GET(^PRCA(430,BN,7))
+6 SET SITE=$SELECT($PIECE($GET(^PRCA(430,BN,0)),"^",12):$PIECE($GET(^PRCA(430,BN,0)),"^",12),1:"SITE UNKNOWN")
+7 IF '$DATA(^TMP("DEBTOR",$JOB,SITE,DEB))
SET TOTVET=TOTVET+1
+8 SET PB=PB+$PIECE(BAL,"^",1)
SET INT=INT+$PIECE(BAL,"^",2)
SET ADM=ADM+$PIECE(BAL,"^",3)
+9 SET BBAL=$PIECE(BAL,"^",1)+$PIECE(BAL,"^",2)+$PIECE(BAL,"^",3)
+10 SET ^TMP("DEBTOR",$JOB,SITE,DEB,+RCDFN,BN)=$PIECE(BAL,"^",1)_"^"_$PIECE(BAL,"^",2)_"^"_$PIECE(BAL,"^",3)_"^"_BBAL
+11 SET ^TMP("RCDEBTOR",$JOB,SITE,DEB,+RCDFN)=PB_"^"_INT_"^"_ADM_"^"_(PB+INT+ADM)
+12 SET RCTOT=$GET(^TMP("RCTOT",$JOB,SITE))
SET $PIECE(^TMP("RCTOT",$JOB,SITE),"^",1)=$PIECE(RCTOT,"^",1)+$PIECE(BAL,"^",1)
SET $PIECE(^TMP("RCTOT",$JOB,SITE),"^",2)=$PIECE(RCTOT,"^",2)+$PIECE(BAL,"^",2)
+13 SET $PIECE(^TMP("RCTOT",$JOB,SITE),"^",3)=$PIECE(RCTOT,"^",3)+$PIECE(BAL,"^",3)
SET $PIECE(^TMP("RCTOT",$JOB,SITE),"^",4)=$PIECE(RCTOT,"^",4)+BBAL
+14 QUIT
End DoDot:1
BBALQ QUIT
PRINT ;PRINT THE REPORT
+1 SET $PIECE(RCDCL,"=",81)=""
SET (SITE,RCPAG)=0
+2 DO HEAD
+3 IF '$DATA(^TMP("RCDEBTOR",$JOB))
WRITE !!,"No data meets this criteria"
QUIT
+4 IF RCTYPE="D"
Begin DoDot:1
+5 SET RCFLAG=0
FOR
SET SITE=$ORDER(^TMP("DEBTOR",$JOB,SITE))
if SITE=""!(RCFLAG)
QUIT
SET DEB=0
FOR
SET DEB=$ORDER(^TMP("DEBTOR",$JOB,SITE,DEB))
if DEB=""!(RCFLAG)
QUIT
Begin DoDot:2
+6 SET DFN=0
FOR
SET DFN=$ORDER(^TMP("DEBTOR",$JOB,SITE,DEB,DFN))
if DFN=""!(RCFLAG)
QUIT
SET BN=0
FOR
SET BN=$ORDER(^TMP("DEBTOR",$JOB,SITE,DEB,DFN,BN))
if BN=""!(RCFLAG)
QUIT
if $Y+5>IOSL
DO RET
if RCFLAG
QUIT
DO PRDATA
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 IF RCTYPE="D"
if RCFLAG
QUIT
SET RCTYPE="S"
SET RCPAG=0
DO RET
if RCFLAG
QUIT
+10 IF RCTYPE="S"
Begin DoDot:1
+11 FOR
SET SITE=$ORDER(^TMP("RCTOT",$JOB,SITE))
if SITE=""
QUIT
DO PRDATA
+12 QUIT
End DoDot:1
+13 QUIT
RET ;
+1 FOR X=$Y:1:(IOSL-3)
WRITE !
+2 IF IOST'?1"C-".E
Begin DoDot:1
+3 IF RCTYPE="D"
KILL ^TMP("RCSITE",$JOB,SITE),^TMP("RCDFN",$JOB,DFN)
+4 DO HEAD
End DoDot:1
QUIT
+5 NEW DIR,DUOUT,DTOUT
+6 SET DIR(0)="EA"
SET DIR("A")="Enter <RET> to continue or ^ to quit "
DO ^DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCFLAG=1
if RCFLAG
QUIT
+8 IF RCTYPE="D"
KILL ^TMP("RCSITE",$JOB,SITE),^TMP("RCDFN",$JOB,DFN)
HEAD ;HEADING DETAILED
+1 NEW Y
SET RCPAG=RCPAG+1
+2 WRITE @IOF,"Financial"_$SELECT(RCTYPE="S":" Summary ",1:" Detailed ")_"Statement for Hurricane Katrina ",?53
SET Y=RCDATE
DO DD^%DT
WRITE Y," ",$JUSTIFY("PAGE: "_RCPAG,12),!
+3 IF RCTYPE="S"
Begin DoDot:1
+4 WRITE !,"SITE",?25,"#AFFECTED VETS",?48,"TOTAL AMT.",?65,"AVG. AMOUNT/VET"
End DoDot:1
+5 IF RCTYPE="D"
Begin DoDot:1
+6 WRITE !,"BILL #",?17,"PRINC. BAL",?41,"INT.",?56,"ADM.",?75,"TOTAL"
End DoDot:1
+7 WRITE !,RCDCL
+8 QUIT
PRDATA ;WRITE THE DATA
+1 ;W !
+2 IF RCTYPE="S"
Begin DoDot:1
+3 SET TOTAMT=$PIECE($GET(^TMP("RCTOT",$JOB,SITE)),"^",4)
+4 WRITE !,$PIECE($$SITE^VASITE(),"^",2),?20,$JUSTIFY(TOTVET,18),?40,$JUSTIFY("$"_TOTAMT,18),?60,$JUSTIFY("$"_$PIECE(TOTAMT/TOTVET,".",1)_"."_$EXTRACT($PIECE(TOTAMT/TOTVET,".",2),1,2),18)
+5 SET ^XTMP("RCKATRPT",SITE,"TOTGRAND")=TOTVET_"^"_TOTAMT_"^"_$PIECE(TOTAMT/TOTVET,".",1)_"."_$EXTRACT($PIECE(TOTAMT/TOTVET,".",2),1,2)
End DoDot:1
+6 IF RCTYPE="D"
Begin DoDot:1
+7 NEW DATA
+8 SET DATA=$GET(^TMP("DEBTOR",$JOB,SITE,DEB,DFN,BN))
+9 IF '$DATA(^TMP("RCSITE",$JOB,SITE))
WRITE !,?35,$PIECE($$SITE^VASITE(),"^",2),!
SET ^TMP("RCSITE",$JOB,SITE)=""
+10 IF '$DATA(^TMP("RCDFN",$JOB,DFN))
WRITE !,DEB_":"_$PIECE($GET(^DPT(DFN,0)),"^",1)
SET ^TMP("RCDFN",$JOB,DFN)=""
+11 WRITE !,$PIECE($GET(^PRCA(430,BN,0)),"^",1),?12,$SELECT($PIECE($GET(DATA),"^",1):$JUSTIFY("$"_$PIECE(DATA,"^",1),15),1:$JUSTIFY("$0",15)),?30,$SELECT($PIECE($GET(DATA),"^",2):$JUSTIFY("$"_$PIECE(DATA,"^",2),15),1:$JUSTIFY("$0",15))
+12 WRITE ?45,$SELECT($PIECE($GET(DATA),"^",3):$JUSTIFY("$"_$PIECE(DATA,"^",3),15),1:$JUSTIFY("$0",15)),?65,$SELECT($PIECE($GET(DATA),"^",4):$JUSTIFY("$"_$PIECE(DATA,"^",4),15),1:$JUSTIFY("$0",15))
+13 SET ^TMP("RCSITE",$JOB,SITE)=""
SET ^TMP("RCDFN",$JOB,DFN)=""
+14 IF '$ORDER(^TMP("DEBTOR",$JOB,SITE,DEB,DFN,BN))
Begin DoDot:2
+15 IF $Y+5>IOSL
DO RET
if RCFLAG
QUIT
WRITE !,?35,$PIECE($$SITE^VASITE(),"^",2),!!,DEB_":"_$PIECE($GET(^DPT(DFN,0)),"^",1),!
SET ^TMP("RCSITE",$JOB,SITE)=""
SET ^TMP("RCDFN",$JOB,DFN)=""
+16 NEW X
+17 SET X=$GET(^TMP("RCDEBTOR",$JOB,SITE,DEB,DFN))
+18 SET $PIECE(RCDL,"-",65)=""
WRITE !,"------",?16,RCDL
+19 WRITE !,"TOTAL: ",?12,$JUSTIFY("$"_$PIECE(X,"^",1),15),?30,$JUSTIFY("$"_$PIECE(X,"^",2),15),?45,$JUSTIFY("$"_$PIECE(X,"^",3),15),?65,$JUSTIFY("$"_$PIECE(X,"^",4),15),!
+20 SET ^XTMP("RCKATRPT",SITE,DEB,DFN,"TOT")=DEB_"^"_"^"_X
End DoDot:2
+21 SET ^XTMP("RCKATRPT",SITE,DEB,DFN,BN)=DEB_"^"_BN_"^"_DATA
+22 QUIT
End DoDot:1
+23 QUIT
