RCRJRDEP ;WISC/RFJ-Deposit Reconciliation Report ;9/7/10 8:19am
;;4.5;Accounts Receivable;**101,114,203,220,273,310,338,351,357**;Mar 20, 1995;Build 6
;Per VA Directive 6402, this routine should not be modified.
;
W !!,"This option will print the Deposit Reconciliation Report. The report will"
W !,"display the data on the code sheets sent to FMS on the CR document. Only"
W !,"deposits processed after patch PRCA*4.5*90 was installed can be displayed."
W !,"Select the starting and ending FMS Document Number without the station"
W !,"number, example: K8A0346."
;
N DEFAULT,RCRJEND,RCRJFXIT,RCRJSTRT,RCRJSUMM,X
N %,%H,%I,CATEGORY,CHAMPVA,DA,DEPOSDA,DOCTOTAL,FEE,FMSDOCID,FUND,FUNDTOTL,GECSDATA,IO,IOF
;
F D Q:$G(RCRJFXIT)
. R !!,"START WITH CR DOCUMENT: FIRST// ",X:DTIME
. I X["^" S RCRJFXIT=2 Q
. I $L(X),$L(X)'=7 W !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)." Q
. S RCRJSTRT=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. ;
. S DEFAULT=$S(RCRJSTRT="":" LAST",1:RCRJSTRT)
. W !," END WITH CR DOCUMENT: ",DEFAULT,"// " R X:DTIME
. I X["^" S RCRJFXIT=2 Q
. S RCRJEND=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. I X="LAST" S (RCRJEND,X)="zzzzzzz"
. I $L(X),$L(X)'=7 W !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)." Q
. I X="" S RCRJEND=$S(DEFAULT=" LAST":"zzzzzzz",1:DEFAULT)
. I RCRJEND'=RCRJSTRT,RCRJEND']RCRJSTRT W !?5,"The END CR DOCUMENT should be after (in sequence) the start document." Q
. S RCRJFXIT=1
I RCRJFXIT=2 Q
;
S RCRJSUMM=$$SUMMARY^RCRJRTRA I 'RCRJSUMM Q
;
; select device
W ! S %ZIS="Q" D ^%ZIS Q:POP
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. S ZTDESC="Deposit Reconciliation Report",ZTRTN="DQ^RCRJRDEP"
. S ZTSAVE("RCRJ*")="",ZTSAVE("ZTREQ")="@"
W !!,"<*> please wait <*>"
;
DQ ; report (queue) starts here
N %,%H,%I,CHAMPVA,DA,DEPOSDA,DIQ2,DOCTOTAL,FEE,FMSDOCID,FUND,FUNDTOTL,GECSDATA,LINEDA,LINEDATA,NOW,PAGE,RCDATA,RCRJLAST,RCRJLINE,RCRJFLAG,RECEIPDA,RSC,RSCTOTL,SCREEN,SITE,TOTAL,X,Y
K ^TMP($J,"RCRJRDEP")
;
; build list of fms documents
S SITE=$$SITE^RCMSITE
S RCRJLAST="CR-"_SITE_RCRJEND_" "
;
; the fms document was previously stored in the deposit file 344.1
; this code can be removed later on
; this is the starting document, use 31 to start with select doc first
S FMSDOCID="CR-"_SITE_RCRJSTRT_$C(31)
F S FMSDOCID=$O(^RCY(344.1,"ADOC",FMSDOCID)) Q:FMSDOCID=""!(FMSDOCID]RCRJLAST) D
. S DEPOSDA=+$O(^RCY(344.1,"ADOC",FMSDOCID,0))
. ; compute deposit (all receipts) total for comparison
. S TOTAL=0,CHAMPVA=0,FEE=0
. S RECEIPDA=0 F S RECEIPDA=$O(^RCY(344,"AD",DEPOSDA,RECEIPDA)) Q:'RECEIPDA D
. . S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA S TOTAL=TOTAL+$P(^(DA,0),"^",5)
. . S CHAMPVA=CHAMPVA+$$CHAMPVA(RECEIPDA)
. . S FEE=FEE+$$FEE(RECEIPDA)
. ; tmp=deposit ^ depositda ^ depositdate ^ ^ ^ ^ deposittotal ^ champvatotal ^ feetotal
. S ^TMP($J,"RCRJRDEP",FMSDOCID)=$P($G(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$P($G(^RCY(344.1,DEPOSDA,0)),"^",9)_"^^^^"_TOTAL_"^"_CHAMPVA_"^"_FEE
;
; the fms document is now stored in the receipt file 344
S FMSDOCID="CR-"_SITE_RCRJSTRT_$C(31)
F S FMSDOCID=$O(^RCY(344,"ADOC",FMSDOCID)) Q:FMSDOCID=""!(FMSDOCID]RCRJLAST) D
. S RECEIPDA=+$O(^RCY(344,"ADOC",FMSDOCID,0))
. ; compute deposit (all receipts) total for comparison
. S TOTAL=0
. ; use the payment amount to pick up suspense deposits
. S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA S TOTAL=TOTAL+$P(^(DA,0),"^",4)
. S CHAMPVA=$$CHAMPVA(RECEIPDA)
. S FEE=$$FEE(RECEIPDA)
. S DEPOSDA=+$P($G(^RCY(344,RECEIPDA,0)),"^",6)
. ; tmp=deposit ^ depositda ^ depositdate ^ receipt ^receiptda ^ receipt date ^ receipttotal ^ champvatotal ^ feetotal
. S ^TMP($J,"RCRJRDEP",FMSDOCID)=$P($G(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$P($G(^RCY(344.1,DEPOSDA,0)),"^",11)_"^"_$P($G(^RCY(344,RECEIPDA,0)),"^")_"^"_RECEIPDA_"^"_$P($G(^RCY(344,RECEIPDA,0)),"^",8)_"^"_TOTAL_"^"_CHAMPVA_"^"_FEE
;
; print report
S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
S RCRJLINE="",$P(RCRJLINE,"-",81)=""
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1
U IO I $G(RCRJSUMM)'=1 D H
;
S FMSDOCID="" F S FMSDOCID=$O(^TMP($J,"RCRJRDEP",FMSDOCID)) Q:FMSDOCID=""!($G(RCRJFLAG)) D
. S RCDATA=^TMP($J,"RCRJRDEP",FMSDOCID)
. K GECSDATA
. D DATA^GECSSGET(FMSDOCID,1)
. I $G(RCRJSUMM)'=1 D Q:$G(RCRJFLAG)
. . I $Y>(IOSL-7) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. . S Y=$P($P(RCDATA,"^",3),".") I Y D DD^%DT
. . W !,"FMS DOCUMENT: ",FMSDOCID,?34,"DEPOSIT TICKET: ",$P(RCDATA,"^"),?62,"DATE: ",Y
. . I $P(RCDATA,"^",4)'="" W !?41,"RECEIPT: ",$P(RCDATA,"^",4) S Y=$P($P(RCDATA,"^",6),".") I Y D DD^%DT W ?62,"DATE: ",Y
. . D H1
. S DOCTOTAL=0
. I $D(GECSDATA) S LINEDA=0 F S LINEDA=$O(GECSDATA(2100.1,GECSDATA,10,LINEDA)) Q:'LINEDA!($G(RCRJFLAG)) D
. . S LINEDATA=GECSDATA(2100.1,GECSDATA,10,LINEDA)
. . I $E(LINEDATA,1,4)="CR2^" S DOCTOTAL=$P(LINEDATA,"^",15)
. . I $E(LINEDATA,1,9)'="LIN^~CRA^" Q
. . I $G(RCRJSUMM)'=1 D
. . . I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H,H1
. . . W !?1,$P(LINEDATA,"^",3),?6,$P(LINEDATA,"^",4),?11,$P(LINEDATA,"^",6),?19,$P(LINEDATA,"^",10)
. . . W ?30,$J($P(LINEDATA,"^",18),8),?40,$E($P(LINEDATA,"^",25),4,10),?50,$J($P(LINEDATA,"^",20),10,2),?64,$J($P(LINEDATA,"^",23),9)
. . ; totals by fund
. . S FUND=$P(LINEDATA,"^",6)
. . I FUND="" S FUND="0160"
. . S FUNDTOTL(FUND)=$G(FUNDTOTL(FUND))+$P(LINEDATA,"^",20)
. . ; totals by rsc for the accrued 5287 funds (01,03,04,09,11,13,14)
. . S RSC=$P(LINEDATA,"^",10)
. . I RSC'="",($$PTACCT^PRCAACC(FUND)!(FUND=4032)) S RSCTOTL(RSC)=$G(RSCTOTL(RSC))+$P(LINEDATA,"^",20)
. I $G(RCRJSUMM)=1 Q
. I $G(RCRJFLAG) Q
. I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
. W !?23,"LINE TOTAL/DOCUMENT TOTAL: ",$J(DOCTOTAL,10,2)
. ; compute receipt total for comparison
. S TOTAL=$P(RCDATA,"^",7)
. S CHAMPVA=$P(RCDATA,"^",8)
. S FEE=$P(RCDATA,"^",9)
. I CHAMPVA W !?35,"CHAMPVA TOTAL: ",$J(CHAMPVA,10,2)
. I FEE W !?25,"NON-VA PORTION OF TOTAL: ",$J(FEE,10,2)
. W !?35,"DEPOSIT TOTAL: ",$J(TOTAL,10,2)
. ;I (DOCTOTAL+CHAMPVA+FEE)'=TOTAL W !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: **********"
. I (DOCTOTAL+CHAMPVA)'=TOTAL W !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: **********"
. W !
;
I $G(RCRJFLAG) D Q Q
I $G(RCRJSUMM)'=1 D:SCREEN PAUSE^RCRJRTR1 I $G(RCRJFLAG) D Q Q
D H
; print totals by fund/rsc
W !!,"TOTAL DEPOSITS BY FUND:"
S FUND="" F S FUND=$O(FUNDTOTL(FUND)) Q:FUND=""!($G(RCRJFLAG)) D
. I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !!,"TOTAL DEPOSITS BY FUND:"
. W !?5,"FUND: ",FUND,?20,$J(FUNDTOTL(FUND),10,2)
I $G(RCRJFLAG) D Q Q
I DT<$$ADDPTEDT^PRCAACC() W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 5287.1,5287.3,5287.4:"
I DT'<$$ADDPTEDT^PRCAACC() W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 528701,528703,528704,528711,528713,528714:"
S RSC="" F S RSC=$O(RSCTOTL(RSC)) Q:RSC="" D Q:$G(RCRJFLAG)
. I $Y>(IOSL-4) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H W !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF ACCRUED 5287 FUNDS "_$S(DT<$$ADDPTEDT^PRCAACC():"(.1,.3,.4,.9):",1:"(01,03,04,09,11):")
. W !?5,"RSC: ",RSC,?17,$$GETDESC^RCXFMSPR(RSC),?70,$J(RSCTOTL(RSC),10,2)
I $G(RCRJFLAG) D Q Q
I SCREEN R !,"Press RETURN to continue:",X:DTIME
;
Q D ^%ZISC
K ^TMP($J,"RCRJRDEP")
Q
;
;
H ; report heading
I PAGE'=1!(SCREEN) W @IOF
S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1
W $C(13),"DEPOSIT RECONCILIATION REPORT",?(80-$L(%)),%
W !," START WITH DEPOSIT: ",$S(RCRJSTRT="":"**FIRST**",1:RCRJSTRT)," END WITH DEPOSIT: ",$S(RCRJEND="zzzzzzz":"**LAST**",1:RCRJEND),?65,$J("TYPE: "_$S(RCRJSUMM=1:"SUMMARY",1:"DETAILED"),15)
W !,RCRJLINE
Q
;
;
H1 ; print line heading
W !,"LINE",?5,"BFY",?11,"FUND",?20,"RSC",?30,"PROVIDER",?43,"BILL",?54,"AMOUNT",?64,"TRAN TYPE"
Q
;
;
CHAMPVA(RECEIPDA) ; return dollars for champva
N %,CATEGORY,RECEIPT,TOTAL,TRAN3,TRANDA
S RECEIPT=$P($G(^RCY(344,RECEIPDA,0)),"^")
I RECEIPT="" Q 0
;
S TOTAL=0
S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
. S CATEGORY=$P($G(^PRCA(430,+$P($G(^PRCA(433,TRANDA,0)),"^",2),0)),"^",2)
. I CATEGORY'=29 Q
. S TRAN3=$G(^PRCA(433,TRANDA,3))
. F %=1:1:5 S TOTAL=TOTAL+$P(TRAN3,"^",%)
Q TOTAL
;
;
FEE(RECEIPDA) ; return dollars for Fee Basis PRCA*4.5*310/DRF 12/9/2015
N %,CATEGORY,RECEIPT,TOTAL,TRAN3,TRANDA
S RECEIPT=$P($G(^RCY(344,RECEIPDA,0)),"^")
I RECEIPT="" Q 0
S TOTAL=0
S TRANDA=0 F S TRANDA=$O(^PRCA(433,"AF",RECEIPT,TRANDA)) Q:'TRANDA D
. S CATEGORY=$P($G(^PRCA(430,+$P($G(^PRCA(433,TRANDA,0)),"^",2),0)),"^",2)
. I '$$CHKIEN(CATEGORY) Q ; verify category is Non-VA care (PRCA*4.5*338)
. S TRAN3=$G(^PRCA(433,TRANDA,3))
. F %=1:1:5 S TOTAL=TOTAL+$P(TRAN3,"^",%)
Q TOTAL
;
CHKIEN(RCCAT) ; return true if AR CATEGORIES are Non-VA Care (PRCA*4.5*338)
I RCCAT=45 Q 1
;PRCA*4.5*351 - Added Community Care to Non-VA check
I RCCAT>47&(RCCAT<75) Q 1
I RCCAT>80&(RCCAT<85) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRJRDEP 9291 printed Apr 09, 2024@20:53:04 Page 2
RCRJRDEP ;WISC/RFJ-Deposit Reconciliation Report ;9/7/10 8:19am
+1 ;;4.5;Accounts Receivable;**101,114,203,220,273,310,338,351,357**;Mar 20, 1995;Build 6
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 WRITE !!,"This option will print the Deposit Reconciliation Report. The report will"
+5 WRITE !,"display the data on the code sheets sent to FMS on the CR document. Only"
+6 WRITE !,"deposits processed after patch PRCA*4.5*90 was installed can be displayed."
+7 WRITE !,"Select the starting and ending FMS Document Number without the station"
+8 WRITE !,"number, example: K8A0346."
+9 ;
+10 NEW DEFAULT,RCRJEND,RCRJFXIT,RCRJSTRT,RCRJSUMM,X
+11 NEW %,%H,%I,CATEGORY,CHAMPVA,DA,DEPOSDA,DOCTOTAL,FEE,FMSDOCID,FUND,FUNDTOTL,GECSDATA,IO,IOF
+12 ;
+13 FOR
Begin DoDot:1
+14 READ !!,"START WITH CR DOCUMENT: FIRST// ",X:DTIME
+15 IF X["^"
SET RCRJFXIT=2
QUIT
+16 IF $LENGTH(X)
IF $LENGTH(X)'=7
WRITE !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)."
QUIT
+17 SET RCRJSTRT=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+18 ;
+19 SET DEFAULT=$SELECT(RCRJSTRT="":" LAST",1:RCRJSTRT)
+20 WRITE !," END WITH CR DOCUMENT: ",DEFAULT,"// "
READ X:DTIME
+21 IF X["^"
SET RCRJFXIT=2
QUIT
+22 SET RCRJEND=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+23 IF X="LAST"
SET (RCRJEND,X)="zzzzzzz"
+24 IF $LENGTH(X)
IF $LENGTH(X)'=7
WRITE !?5,"The CR DOCUMENT should be 7 characters in length (example: K8A0804)."
QUIT
+25 IF X=""
SET RCRJEND=$SELECT(DEFAULT=" LAST":"zzzzzzz",1:DEFAULT)
+26 IF RCRJEND'=RCRJSTRT
IF RCRJEND']RCRJSTRT
WRITE !?5,"The END CR DOCUMENT should be after (in sequence) the start document."
QUIT
+27 SET RCRJFXIT=1
End DoDot:1
if $GET(RCRJFXIT)
QUIT
+28 IF RCRJFXIT=2
QUIT
+29 ;
+30 SET RCRJSUMM=$$SUMMARY^RCRJRTRA
IF 'RCRJSUMM
QUIT
+31 ;
+32 ; select device
+33 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+34 IF $DATA(IO("Q"))
Begin DoDot:1
+35 SET ZTDESC="Deposit Reconciliation Report"
SET ZTRTN="DQ^RCRJRDEP"
+36 SET ZTSAVE("RCRJ*")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+37 WRITE !!,"<*> please wait <*>"
+38 ;
DQ ; report (queue) starts here
+1 NEW %,%H,%I,CHAMPVA,DA,DEPOSDA,DIQ2,DOCTOTAL,FEE,FMSDOCID,FUND,FUNDTOTL,GECSDATA,LINEDA,LINEDATA,NOW,PAGE,RCDATA,RCRJLAST,RCRJLINE,RCRJFLAG,RECEIPDA,RSC,RSCTOTL,SCREEN,SITE,TOTAL,X,Y
+2 KILL ^TMP($JOB,"RCRJRDEP")
+3 ;
+4 ; build list of fms documents
+5 SET SITE=$$SITE^RCMSITE
+6 SET RCRJLAST="CR-"_SITE_RCRJEND_" "
+7 ;
+8 ; the fms document was previously stored in the deposit file 344.1
+9 ; this code can be removed later on
+10 ; this is the starting document, use 31 to start with select doc first
+11 SET FMSDOCID="CR-"_SITE_RCRJSTRT_$CHAR(31)
+12 FOR
SET FMSDOCID=$ORDER(^RCY(344.1,"ADOC",FMSDOCID))
if FMSDOCID=""!(FMSDOCID]RCRJLAST)
QUIT
Begin DoDot:1
+13 SET DEPOSDA=+$ORDER(^RCY(344.1,"ADOC",FMSDOCID,0))
+14 ; compute deposit (all receipts) total for comparison
+15 SET TOTAL=0
SET CHAMPVA=0
SET FEE=0
+16 SET RECEIPDA=0
FOR
SET RECEIPDA=$ORDER(^RCY(344,"AD",DEPOSDA,RECEIPDA))
if 'RECEIPDA
QUIT
Begin DoDot:2
+17 SET DA=0
FOR
SET DA=$ORDER(^RCY(344,RECEIPDA,1,DA))
if 'DA
QUIT
SET TOTAL=TOTAL+$PIECE(^(DA,0),"^",5)
+18 SET CHAMPVA=CHAMPVA+$$CHAMPVA(RECEIPDA)
+19 SET FEE=FEE+$$FEE(RECEIPDA)
End DoDot:2
+20 ; tmp=deposit ^ depositda ^ depositdate ^ ^ ^ ^ deposittotal ^ champvatotal ^ feetotal
+21 SET ^TMP($JOB,"RCRJRDEP",FMSDOCID)=$PIECE($GET(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$PIECE($GET(^RCY(344.1,DEPOSDA,0)),"^",9)_"^^^^"_TOTAL_"^"_CHAMPVA_"^"_FEE
End DoDot:1
+22 ;
+23 ; the fms document is now stored in the receipt file 344
+24 SET FMSDOCID="CR-"_SITE_RCRJSTRT_$CHAR(31)
+25 FOR
SET FMSDOCID=$ORDER(^RCY(344,"ADOC",FMSDOCID))
if FMSDOCID=""!(FMSDOCID]RCRJLAST)
QUIT
Begin DoDot:1
+26 SET RECEIPDA=+$ORDER(^RCY(344,"ADOC",FMSDOCID,0))
+27 ; compute deposit (all receipts) total for comparison
+28 SET TOTAL=0
+29 ; use the payment amount to pick up suspense deposits
+30 SET DA=0
FOR
SET DA=$ORDER(^RCY(344,RECEIPDA,1,DA))
if 'DA
QUIT
SET TOTAL=TOTAL+$PIECE(^(DA,0),"^",4)
+31 SET CHAMPVA=$$CHAMPVA(RECEIPDA)
+32 SET FEE=$$FEE(RECEIPDA)
+33 SET DEPOSDA=+$PIECE($GET(^RCY(344,RECEIPDA,0)),"^",6)
+34 ; tmp=deposit ^ depositda ^ depositdate ^ receipt ^receiptda ^ receipt date ^ receipttotal ^ champvatotal ^ feetotal
+35 SET ^TMP($JOB,"RCRJRDEP",FMSDOCID)=$PIECE($GET(^RCY(344.1,DEPOSDA,0)),"^")_"^"_DEPOSDA_"^"_$PIECE(...
... $GET(^RCY(344.1,DEPOSDA,0)),"^",11)_"^"_$PIECE($GET(^RCY(344,RECEIPDA,0)),"^")_"^"_RECEIPDA_"^"_$PIECE($GET(^RCY(344,RECEIPDA,0)),"^",8)_"^"_TOTAL_"^"_CHAMPVA_"^"_FEE
End DoDot:1
+36 ;
+37 ; print report
+38 SET SCREEN=0
IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET SCREEN=1
+39 SET RCRJLINE=""
SET $PIECE(RCRJLINE,"-",81)=""
+40 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
SET PAGE=1
+41 USE IO
IF $GET(RCRJSUMM)'=1
DO H
+42 ;
+43 SET FMSDOCID=""
FOR
SET FMSDOCID=$ORDER(^TMP($JOB,"RCRJRDEP",FMSDOCID))
if FMSDOCID=""!($GET(RCRJFLAG))
QUIT
Begin DoDot:1
+44 SET RCDATA=^TMP($JOB,"RCRJRDEP",FMSDOCID)
+45 KILL GECSDATA
+46 DO DATA^GECSSGET(FMSDOCID,1)
+47 IF $GET(RCRJSUMM)'=1
Begin DoDot:2
+48 IF $Y>(IOSL-7)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+49 SET Y=$PIECE($PIECE(RCDATA,"^",3),".")
IF Y
DO DD^%DT
+50 WRITE !,"FMS DOCUMENT: ",FMSDOCID,?34,"DEPOSIT TICKET: ",$PIECE(RCDATA,"^"),?62,"DATE: ",Y
+51 IF $PIECE(RCDATA,"^",4)'=""
WRITE !?41,"RECEIPT: ",$PIECE(RCDATA,"^",4)
SET Y=$PIECE($PIECE(RCDATA,"^",6),".")
IF Y
DO DD^%DT
WRITE ?62,"DATE: ",Y
+52 DO H1
End DoDot:2
if $GET(RCRJFLAG)
QUIT
+53 SET DOCTOTAL=0
+54 IF $DATA(GECSDATA)
SET LINEDA=0
FOR
SET LINEDA=$ORDER(GECSDATA(2100.1,GECSDATA,10,LINEDA))
if 'LINEDA!($GET(RCRJFLAG))
QUIT
Begin DoDot:2
+55 SET LINEDATA=GECSDATA(2100.1,GECSDATA,10,LINEDA)
+56 IF $EXTRACT(LINEDATA,1,4)="CR2^"
SET DOCTOTAL=$PIECE(LINEDATA,"^",15)
+57 IF $EXTRACT(LINEDATA,1,9)'="LIN^~CRA^"
QUIT
+58 IF $GET(RCRJSUMM)'=1
Begin DoDot:3
+59 IF $Y>(IOSL-4)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
DO H1
+60 WRITE !?1,$PIECE(LINEDATA,"^",3),?6,$PIECE(LINEDATA,"^",4),?11,$PIECE(LINEDATA,"^",6),?19,$PIECE(LINEDATA,"^",10)
+61 WRITE ?30,$JUSTIFY($PIECE(LINEDATA,"^",18),8),?40,$EXTRACT($PIECE(LINEDATA,"^",25),4,10),?50,$JUSTIFY($PIECE(LINEDATA,"^",20),10,2),?64,$JUSTIFY($PIECE(LINEDATA,"^",23),9)
End DoDot:3
+62 ; totals by fund
+63 SET FUND=$PIECE(LINEDATA,"^",6)
+64 IF FUND=""
SET FUND="0160"
+65 SET FUNDTOTL(FUND)=$GET(FUNDTOTL(FUND))+$PIECE(LINEDATA,"^",20)
+66 ; totals by rsc for the accrued 5287 funds (01,03,04,09,11,13,14)
+67 SET RSC=$PIECE(LINEDATA,"^",10)
+68 IF RSC'=""
IF ($$PTACCT^PRCAACC(FUND)!(FUND=4032))
SET RSCTOTL(RSC)=$GET(RSCTOTL(RSC))+$PIECE(LINEDATA,"^",20)
End DoDot:2
+69 IF $GET(RCRJSUMM)=1
QUIT
+70 IF $GET(RCRJFLAG)
QUIT
+71 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
+72 WRITE !?23,"LINE TOTAL/DOCUMENT TOTAL: ",$JUSTIFY(DOCTOTAL,10,2)
+73 ; compute receipt total for comparison
+74 SET TOTAL=$PIECE(RCDATA,"^",7)
+75 SET CHAMPVA=$PIECE(RCDATA,"^",8)
+76 SET FEE=$PIECE(RCDATA,"^",9)
+77 IF CHAMPVA
WRITE !?35,"CHAMPVA TOTAL: ",$JUSTIFY(CHAMPVA,10,2)
+78 IF FEE
WRITE !?25,"NON-VA PORTION OF TOTAL: ",$JUSTIFY(FEE,10,2)
+79 WRITE !?35,"DEPOSIT TOTAL: ",$JUSTIFY(TOTAL,10,2)
+80 ;I (DOCTOTAL+CHAMPVA+FEE)'=TOTAL W !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: **********"
+81 IF (DOCTOTAL+CHAMPVA)'=TOTAL
WRITE !," WARNING: TOTALS DO NOT MATCH, CHECK THE DEPOSIT: **********"
+82 WRITE !
End DoDot:1
+83 ;
+84 IF $GET(RCRJFLAG)
DO Q
QUIT
+85 IF $GET(RCRJSUMM)'=1
if SCREEN
DO PAUSE^RCRJRTR1
IF $GET(RCRJFLAG)
DO Q
QUIT
+86 DO H
+87 ; print totals by fund/rsc
+88 WRITE !!,"TOTAL DEPOSITS BY FUND:"
+89 SET FUND=""
FOR
SET FUND=$ORDER(FUNDTOTL(FUND))
if FUND=""!($GET(RCRJFLAG))
QUIT
Begin DoDot:1
+90 IF $Y>(IOSL-4)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
WRITE !!,"TOTAL DEPOSITS BY FUND:"
+91 WRITE !?5,"FUND: ",FUND,?20,$JUSTIFY(FUNDTOTL(FUND),10,2)
End DoDot:1
+92 IF $GET(RCRJFLAG)
DO Q
QUIT
+93 IF DT<$$ADDPTEDT^PRCAACC()
WRITE !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 5287.1,5287.3,5287.4:"
+94 IF DT'<$$ADDPTEDT^PRCAACC()
WRITE !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF FUNDS 528701,528703,528704,528711,528713,528714:"
+95 SET RSC=""
FOR
SET RSC=$ORDER(RSCTOTL(RSC))
if RSC=""
QUIT
Begin DoDot:1
+96 IF $Y>(IOSL-4)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
WRITE !!,"TOTAL DEPOSITS BY REVENUE SOURCE CODE FOR THE SERIES OF ACCRUED 5287 FUNDS "_$SELECT(DT<$$ADDPTEDT^PRCAACC():"(.1,.3,.4,.9):",1:"(01,03,04,09,11):")
+97 WRITE !?5,"RSC: ",RSC,?17,$$GETDESC^RCXFMSPR(RSC),?70,$JUSTIFY(RSCTOTL(RSC),10,2)
End DoDot:1
if $GET(RCRJFLAG)
QUIT
+98 IF $GET(RCRJFLAG)
DO Q
QUIT
+99 IF SCREEN
READ !,"Press RETURN to continue:",X:DTIME
+100 ;
Q DO ^%ZISC
+1 KILL ^TMP($JOB,"RCRJRDEP")
+2 QUIT
+3 ;
+4 ;
H ; report heading
+1 IF PAGE'=1!(SCREEN)
WRITE @IOF
+2 SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
+3 WRITE $CHAR(13),"DEPOSIT RECONCILIATION REPORT",?(80-$LENGTH(%)),%
+4 WRITE !," START WITH DEPOSIT: ",$SELECT(RCRJSTRT="":"**FIRST**",1:RCRJSTRT)," END WITH DEPOSIT: ",$SELECT(RCRJEND="zzzzzzz":"**LAST**",1:RCRJEND),?65,$JUSTIFY("TYPE: "_$SELECT(RCRJSUMM=1:"SUMMARY",1:"DETAILED"),15)
+5 WRITE !,RCRJLINE
+6 QUIT
+7 ;
+8 ;
H1 ; print line heading
+1 WRITE !,"LINE",?5,"BFY",?11,"FUND",?20,"RSC",?30,"PROVIDER",?43,"BILL",?54,"AMOUNT",?64,"TRAN TYPE"
+2 QUIT
+3 ;
+4 ;
CHAMPVA(RECEIPDA) ; return dollars for champva
+1 NEW %,CATEGORY,RECEIPT,TOTAL,TRAN3,TRANDA
+2 SET RECEIPT=$PIECE($GET(^RCY(344,RECEIPDA,0)),"^")
+3 IF RECEIPT=""
QUIT 0
+4 ;
+5 SET TOTAL=0
+6 SET TRANDA=0
FOR
SET TRANDA=$ORDER(^PRCA(433,"AF",RECEIPT,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:1
+7 SET CATEGORY=$PIECE($GET(^PRCA(430,+$PIECE($GET(^PRCA(433,TRANDA,0)),"^",2),0)),"^",2)
+8 IF CATEGORY'=29
QUIT
+9 SET TRAN3=$GET(^PRCA(433,TRANDA,3))
+10 FOR %=1:1:5
SET TOTAL=TOTAL+$PIECE(TRAN3,"^",%)
End DoDot:1
+11 QUIT TOTAL
+12 ;
+13 ;
FEE(RECEIPDA) ; return dollars for Fee Basis PRCA*4.5*310/DRF 12/9/2015
+1 NEW %,CATEGORY,RECEIPT,TOTAL,TRAN3,TRANDA
+2 SET RECEIPT=$PIECE($GET(^RCY(344,RECEIPDA,0)),"^")
+3 IF RECEIPT=""
QUIT 0
+4 SET TOTAL=0
+5 SET TRANDA=0
FOR
SET TRANDA=$ORDER(^PRCA(433,"AF",RECEIPT,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:1
+6 SET CATEGORY=$PIECE($GET(^PRCA(430,+$PIECE($GET(^PRCA(433,TRANDA,0)),"^",2),0)),"^",2)
+7 ; verify category is Non-VA care (PRCA*4.5*338)
IF '$$CHKIEN(CATEGORY)
QUIT
+8 SET TRAN3=$GET(^PRCA(433,TRANDA,3))
+9 FOR %=1:1:5
SET TOTAL=TOTAL+$PIECE(TRAN3,"^",%)
End DoDot:1
+10 QUIT TOTAL
+11 ;
CHKIEN(RCCAT) ; return true if AR CATEGORIES are Non-VA Care (PRCA*4.5*338)
+1 IF RCCAT=45
QUIT 1
+2 ;PRCA*4.5*351 - Added Community Care to Non-VA check
+3 IF RCCAT>47&(RCCAT<75)
QUIT 1
+4 IF RCCAT>80&(RCCAT<85)
QUIT 1
+5 QUIT 0
