229 lines
9.5 KiB
Mathematica
229 lines
9.5 KiB
Mathematica
RCDPE215 ;ALB/TMK- SF215 EDI Lockbox Summary Report ;1 Jun 99
|
|
;;4.5;Accounts Receivable;**114,173,220**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
SUMM215 ; summary 215
|
|
D FULL^VALM1
|
|
S VALMBCK="R"
|
|
;
|
|
N %,%ZIS,POP,RCDEPTDA,RCTYPE,DIC,X,Y,ZTSAVE,ZTDESC,ZTSK,ZTRTN
|
|
;
|
|
S DIC(0)="AEMQ",DIC="^RCY(344.1,",DIC("A")="Select DEPOSIT: "
|
|
D ^DIC K DIC
|
|
I Y'>0 Q
|
|
S RCDEPTDA=+Y
|
|
S RCTYPE=$$GETTYPE^RCDPR215
|
|
I RCTYPE="" Q
|
|
;
|
|
; device
|
|
W ! S %ZIS="Q" D ^%ZIS Q:POP
|
|
I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D ^%ZISC Q
|
|
. S ZTDESC="Print Summary 215 Report",ZTRTN="DQ^RCDPE215"
|
|
. S ZTSAVE("RCDEPTDA")="",ZTSAVE("RCTYPE")="",ZTSAVE("ZTREQ")="@"
|
|
W !!,"<*> please wait <*>"
|
|
D DQ
|
|
Q
|
|
;
|
|
DQ ; queued report entrypoint
|
|
; RCDEPTDA = ien of the deposit to summarize
|
|
; RCTYPE="D"etail or "A"ccrual
|
|
N %I,AMOUNT,BILL,BILLDA,COMMENTS,COUNT,DA,DATA,DEPOSIT,FMSDOCNO,FUND,NOW,PAGE,PIECE,PRINTOTL,RCSTFLAG,RCYLINE,RECEIPT,SCREEN,TOTAL,TOTLAMT,UNAPPLY,X,Y,RCDETAIL,PCT,RECEIPDA,TOT,EDITOT,DETAIL,Z,EFTFUND
|
|
;
|
|
; calculate report
|
|
K ^TMP($J,"RCFMSCR"),^TMP($J,"RCFMSCR_SUM"),^TMP($J,"RCDPR215"),^TMP($J,"RCDET")
|
|
S EFTFUND=$S(DT<$$ADDPTEDT^PRCAACC():"5287.4/8NZZ",1:"528704/8NZZ")
|
|
S DEPOSIT=$P($G(^RCY(344.1,RCDEPTDA,0)),U)
|
|
S RECEIPDA=0 F S RECEIPDA=$O(^RCY(344,"AD",RCDEPTDA,RECEIPDA)) Q:'RECEIPDA D
|
|
. D FMSLINES^RCXFMSC1(RECEIPDA)
|
|
. ; sort by Receipt #
|
|
. S ^TMP($J,"RCFMSCR_SUM",RECEIPDA)=""
|
|
. M ^TMP($J,"RCFMSCR_SUM",RECEIPDA)=^TMP($J,"RCFMSCR")
|
|
. K ^TMP($J,"RCFMSCR")
|
|
. I $$EDILB^RCDPEU(RECEIPDA)=1 D ; EFT dep receipt
|
|
.. S TOT=0
|
|
.. S Z=0 F S Z=$O(^RCY(344,RECEIPDA,1,Z)) Q:'Z S TOT=TOT+$P($G(^(Z,0)),U,4)
|
|
.. S (^TMP($J,"RCFMSCR_SUM",RECEIPDA,EFTFUND),^TMP($J,"RCTOT","EDILBOX"))=TOT
|
|
;
|
|
; summary rep for a deposit
|
|
S PAGE=0,RCYLINE="",$P(RCYLINE,"-",81)=""
|
|
D NOW^%DTC S Y=% D DD^%DT S NOW=Y
|
|
S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
|
|
U IO
|
|
K ^TMP($J,"RCTOT")
|
|
S RCDETAIL=1,PCT=0,EDITOT=0
|
|
S RECEIPDA=0 F S RECEIPDA=$O(^TMP($J,"RCFMSCR_SUM",RECEIPDA)) Q:'RECEIPDA D
|
|
. S DATA=$G(^RCY(344,RECEIPDA,0))
|
|
. S RECEIPT=$P(DATA,"^")
|
|
. S FMSDOCNO=$P($G(^RCY(344.1,+$P(DATA,"^",6),2)),"^")
|
|
. D SET("<NP>",RECEIPT_"@"_FMSDOCNO_"@"_RECEIPDA,.PCT)
|
|
. ;
|
|
. S TOTAL="" ; stores printotal^inttotal^admintotal^marshtotal^cctotal
|
|
. ;
|
|
. S FUND="" F S FUND=$O(^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND)) Q:'FUND D
|
|
.. D SET("!!?5","Appropriation: "_FUND,.PCT)
|
|
.. I RCTYPE="D" D SET("!","",.PCT)
|
|
.. ;
|
|
.. S PRINTOTL=0
|
|
.. S COUNT=0
|
|
.. I FUND=EFTFUND S PRINTOTL=PRINTOTL+$G(^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND)),EDITOT=EDITOT+$G(^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND))
|
|
.. S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND,BILLDA)) Q:'BILLDA D
|
|
... S COUNT=COUNT+1
|
|
... S BILL=$P($G(^PRCA(430,BILLDA,0)),"^")
|
|
... S DATA=^TMP($J,"RCFMSCR_SUM",RECEIPDA,FUND,BILLDA)
|
|
... S PRINTOTL=PRINTOTL+$P(DATA,"^")
|
|
... F PIECE=1:1:5 S $P(TOTAL,"^",PIECE)=$P(TOTAL,"^",PIECE)+$P(DATA,"^",PIECE),$P(^TMP($J,"RCTOT","TOTAL"),"^",PIECE)=$P($G(^TMP($J,"RCTOT","TOTAL")),"^",PIECE)+$P(DATA,"^",PIECE)
|
|
... ; if accrued report,no detail
|
|
... I RCTYPE="A" Q
|
|
... ;
|
|
... D SET("!?5",COUNT_")",.PCT),SET("?10",BILL,.PCT),SET("?30",$J($P(DATA,"^"),10,2),.PCT),SET("?45","DEBTOR: "_$E($$DEBTOR^RCDPR215(BILLDA),1,25),.PCT)
|
|
... D SET("!?15","INT:"_$J($P(DATA,"^",2),10,2)_" ADMIN:"_$J($P(DATA,"^",3),10,2)_" MARS: "_$J($P(DATA,"^",4),10,2)_" CC: "_$J($P(DATA,"^",5),10,2),.PCT,1)
|
|
.. ;
|
|
.. I RCTYPE="D" D SET("!?30","----------",.PCT),SET("!?5","TOTAL for "_FUND,.PCT)
|
|
.. D SET("?30",$J(PRINTOTL,10,2),.PCT)
|
|
.. I FUND="0160a1" D SET("?45","0160a1 sub-totals Champva receipts",.PCT),SET("!?45","not sent to FMS on the CR document.",.PCT)
|
|
.. S ^TMP($J,"RCTOT","PRINTOTL",FUND)=$G(^TMP($J,"RCTOT","PRINTOTL",FUND))+PRINTOTL
|
|
.. I FUND=EFTFUND S $P(^TMP($J,"RCTOT","TOTAL"),U)=$P($G(^TMP($J,"RCTOT","TOTAL")),U)+PRINTOTL
|
|
. ;
|
|
. ; show int, admin, etc receipt totals
|
|
. D SET("!","",.PCT)
|
|
. D SET("!?5","INTEREST : (APP: 1435)",.PCT),SET("?30",$J($P(TOTAL,"^",2),10,2),.PCT)
|
|
. D SET("!?5","ADMIN : (APP: 3220)",.PCT),SET("?30",$J($P(TOTAL,"^",3),10,2),.PCT)
|
|
. D SET("!?5","MARSHALL : (APP: 0869)",.PCT),SET("?30",$J($P(TOTAL,"^",4),10,2),.PCT)
|
|
. D SET("!?5","COURTCOST: (APP: 0869)",.PCT),SET("?30",$J($P(TOTAL,"^",5),10,2),.PCT)
|
|
. D SET("!?30","----------",.PCT)
|
|
. D SET("!?30",$J($P(TOTAL,"^",2)+$P(TOTAL,"^",3)+$P(TOTAL,"^",4)+$P(TOTAL,"^",5),10,2),.PCT)
|
|
. ;
|
|
. I $G(^TMP($J,"RCFMSCR_SUM",RECEIPDA,EFTFUND)) S $P(TOTAL,U)=$P(TOTAL,U)+^TMP($J,"RCFMSCR_SUM",RECEIPDA,EFTFUND)
|
|
. D SUSP(RECEIPDA,RCTYPE,.TOTAL,.PCT)
|
|
. ;
|
|
. S TOTLAMT=0 F PIECE=1:1:5 S TOTLAMT=TOTLAMT+$P(TOTAL,"^",PIECE)
|
|
. D SET("!!","TOTALS: ",.PCT)
|
|
. D SET("!?5","TOTAL AMT POSTED FOR RECEIPT:",.PCT),SET("?30",$J(TOTLAMT,10,2),.PCT,1)
|
|
;
|
|
D H
|
|
W !!,"**** GRAND TOTALS FOR DEPOSIT: "_$P($G(^RCY(344.1,+RCDEPTDA,0)),U)
|
|
S TOT=0
|
|
S FUND="" F S FUND=$O(^TMP($J,"RCTOT","PRINTOTL",FUND)) Q:FUND="" D
|
|
. W !!?5,"Appropriation: ",FUND,": ",?35,$J($G(^TMP($J,"RCTOT","PRINTOTL",FUND)),10,2)
|
|
. S TOT=TOT+$G(^TMP($J,"RCTOT","PRINTOTL",FUND))
|
|
W !,?35,"=============",!,"Total Appropriation: ",?35,$J(+TOT,10,2)
|
|
I FUND="0160a1" W ?47,"0160a1 sub-totals Champva receipts",!?47,"not sent to FMS on the CR doc."
|
|
;
|
|
S TOTAL=$G(^TMP($J,"RCTOT","TOTAL"))
|
|
W !
|
|
W !?5,"INTEREST : (APP: 1435)",?35,$J($P(TOTAL,"^",2),10,2)
|
|
W !?5,"ADMIN : (APP: 3220)",?35,$J($P(TOTAL,"^",3),10,2)
|
|
W !?5,"MARSHALL : (APP: 0869)",?35,$J($P(TOTAL,"^",4),10,2)
|
|
W !?5,"COURTCOST: (APP: 0869)",?35,$J($P(TOTAL,"^",5),10,2)
|
|
W !?35,"----------"
|
|
W !?35,$J($P(TOTAL,"^",2)+$P(TOTAL,"^",3)+$P(TOTAL,"^",4)+$P(TOTAL,"^",5),10,2)
|
|
I $G(^TMP($J,"RCTOT","SUSPENSE")) W !!?5,"Total Appropriation: 3875",?35,$J(^TMP($J,"RCTOT","SUSPENSE"),10,2)
|
|
;
|
|
S TOTLAMT=0 F PIECE=1:1:5 S TOTLAMT=TOTLAMT+$P(TOTAL,"^",PIECE)
|
|
I $G(^TMP($J,"RCTOT","EDILBOX")) S TOTLAMT=TOTLAMT+^TMP($J,"RCTOT","EDILBOX")
|
|
W !!,"TOTALS: "
|
|
W !?5,"TOT AMT POSTED FOR DEPOSIT: ",?35,$J(+TOTLAMT,10,2)
|
|
I SCREEN D PAUSE G:$G(RCSTFLAG) Q
|
|
N Q,W,T,NS
|
|
S W=""
|
|
S PCT=0 F S PCT=$O(^TMP($J,"RCDET",PCT)) Q:'PCT D G:$G(RCSTFLAG) Q
|
|
. S Q=$P($G(^TMP($J,"RCDET",PCT)),U),T=$P($G(^(PCT)),U,2),NS=$P($G(^(PCT)),U,3)
|
|
. I Q="<NP>" D Q
|
|
.. I W'="" W @W S W="" D:SCREEN PAUSE Q:$G(RCSTFLAG)
|
|
.. S RECEIPT=$P(T,"@"),FMSDOCNO=$P(T,"@",2),RECEIPDA=$P(T,"@",3)
|
|
.. D H,H1(0)
|
|
. I $E(Q)="!" W:W'="" @W S W=""
|
|
. S W=W_$S(W="":"",1:",")_Q_$S(Q'="":",",1:"")_""""_T_""""
|
|
. I 'NS,$Y>(IOSL-6) D:SCREEN PAUSE I '$G(RCSTFLAG) D H,H1(1)
|
|
I W'="" W @W S W=""
|
|
I SCREEN W !,"Press RETURN to continue: " R X:DTIME
|
|
;
|
|
Q D ^%ZISC
|
|
K ^TMP($J,"RCFMSCR"),^TMP($J,"RCDPR215"),^TMP($J,"RCTOT"),^TMP($J,"RCFMSCR_SUM"),^TMP($J,"RCDET")
|
|
Q
|
|
;
|
|
;
|
|
SUSP(RECEIPDA,RCTYPE,TOTAL,PCT) ; unapplied amts for suspense
|
|
; RCTYPE = see explanation at DQ above
|
|
; Returns PCT,TOTAL if passed by reference
|
|
;
|
|
N DA,AMOUNT,UNAPPLY,COUNT,PRINTOTL,COMMENTS
|
|
K ^TMP($J,"RCDPR215")
|
|
S DA=0 F S DA=$O(^RCY(344,RECEIPDA,1,DA)) Q:'DA D
|
|
. S AMOUNT=$P($G(^RCY(344,RECEIPDA,1,DA,0)),"^",4) I 'AMOUNT Q
|
|
. S UNAPPLY=$P($G(^RCY(344,RECEIPDA,1,DA,2)),"^",5) I UNAPPLY="" Q
|
|
. ; if amount has not been processed, show it in suspense
|
|
. I '$P(^RCY(344,RECEIPDA,1,DA,0),"^",5) S ^TMP($J,"RCDPR215",DA)=UNAPPLY_"^"_AMOUNT_"^"_$P($G(^RCY(344,RECEIPDA,1,DA,1)),"^",2)
|
|
;
|
|
I $O(^TMP($J,"RCDPR215",0)) D
|
|
. D SET("!!?5","Appropriation: 3875",.PCT)
|
|
. I RCTYPE="D" D SET("!","",.PCT)
|
|
. ;
|
|
. S COUNT=0,PRINTOTL=0
|
|
. S DA=0 F S DA=$O(^TMP($J,"RCDPR215",DA)) Q:'DA!($G(RCSTFLAG)) D
|
|
. . ;
|
|
. . S UNAPPLY=$P(^TMP($J,"RCDPR215",DA),"^"),AMOUNT=$P(^(DA),"^",2),COMMENTS=$P(^(DA),"^",3)
|
|
. . S PRINTOTL=PRINTOTL+AMOUNT
|
|
. . S $P(TOTAL,"^")=$P(TOTAL,"^")+AMOUNT
|
|
. . ; no detail if accrued report
|
|
. . I RCTYPE="A" Q
|
|
. . ;
|
|
. . S COUNT=COUNT+1
|
|
. . D SET("!?5",COUNT_")",.PCT),SET("?10",UNAPPLY,.PCT),SET("?30",$J(AMOUNT,10,2),.PCT),SET("?45","COMMENTS: "_$E(COMMENTS,1,25),.PCT)
|
|
. . I $TR($E(COMMENTS,26,80)," ")'="" D SET("!?25",$E(COMMENTS,26,80),.PCT)
|
|
. ;
|
|
. S $P(^TMP($J,"RCTOT","TOTAL"),U)=($P($G(^TMP($J,"RCTOT","TOTAL")),U)+PRINTOTL)
|
|
. I RCTYPE="D" D SET("!?30","----------",.PCT),SET("!?5","TOTAL for 3875",.PCT)
|
|
. D SET("?30",$J(PRINTOTL,10,2),.PCT)
|
|
. S ^TMP($J,"RCTOT","SUSPENSE")=$G(^TMP($J,"RCTOT","SUSPENSE"))+PRINTOTL
|
|
Q
|
|
;
|
|
;
|
|
GETTYPE() ; ask type of report to print
|
|
N DIR,X,Y
|
|
S DIR(0)="S^A:ACCRUED;D:DETAILED",DIR("A")="ACCRUED OR DETAILED REPORT",DIR("B")="ACCRUED",DIR("?")="A DETAILED Report will list out accrued bills separately"
|
|
S DIR("?",1)="An ACCRUED Report will list just the accrued total under each appropriation"
|
|
D ^DIR
|
|
I Y'="A",Y'="D" Q ""
|
|
Q Y
|
|
;
|
|
;
|
|
H ; Deposit hdr
|
|
N Z
|
|
S PAGE=PAGE+1 I PAGE'=1!(SCREEN) W @IOF
|
|
W $C(13),"Page ",PAGE,?(80-$L(NOW)),NOW
|
|
W !,$E($TR(RCYLINE,"-","*"),1,26)," 215 DEPOSIT SUMMARY REPORT ",$E($TR(RCYLINE,"-","*"),1,26)
|
|
W !!,"DEPOSIT #: ",DEPOSIT
|
|
W !,RCYLINE
|
|
Q
|
|
;
|
|
H1(CONT) ; Receipt Hdr
|
|
; CONT = 1 if continuation from previous page
|
|
;
|
|
N Z
|
|
W !!,"RECEIPT #: "_RECEIPT_$S($G(CONT):" (continued)",1:"")
|
|
I FMSDOCNO'="" W ?51,"FMS Document #: ",FMSDOCNO
|
|
S Z="",$P(Z,"-",$L(RECEIPT)+1)=""
|
|
W !,?11,Z
|
|
S Z=""
|
|
I $P($G(^RCY(344,RECEIPDA,0)),U,18) S Z=$E(" REFERENCE ERA #: "_$P($G(^RCY(344.4,+$P($G(^RCY(344,RECEIPDA,0)),U,18),0)),U)_" ("_$P($G(^RCY(344.4,+$P($G(^RCY(344,RECEIPDA,0)),U,18),0)),U,2)_")"_$J("",51),1,51)
|
|
I Z'="" W !,Z
|
|
W !
|
|
Q
|
|
;
|
|
;
|
|
PAUSE ;
|
|
D PAUSE^RCDPR215
|
|
Q
|
|
;
|
|
SET(CTRL,TXT,PCT,NOSP) ; Sets print array for detail
|
|
;PCT = count of lines
|
|
;CTRL = Control characters
|
|
;TXT = text to print
|
|
;NOSP = 1 if line should always print with the previous line
|
|
S PCT=PCT+1,^TMP($J,"RCDET",PCT)=CTRL_U_TXT_U_+$G(NOSP)
|
|
Q
|
|
;
|