RCDPE215 ;ALB/TMK- SF215 EDI Lockbox Summary Report ;1 Jun 99
;;4.5;Accounts Receivable;**114,173,220,321**;Mar 20, 1995;Build 48
;;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)
. . ;PRCA*4.5*321 - BEGIN
. . ; Get comment history from RCDPE COMMENT HISTORY file #344.73
. . N RCCHIS,RCCOM,RCSUB
. . D GET^RCDPECH(.RCCHIS,RECEIPDA,DA)
. . S RCSUB=0
. . F S RCSUB=$O(RCCHIS(RCSUB)) Q:'RCSUB D
. . . I RCSUB>1 D
. . . . S RCCOM=$P(RCCHIS(RCSUB),U,3)
. . . . D SET("!?45","COMMENTS: "_$E(RCCOM,1,25),.PCT)
. . . . I $TR($E(RCCOM,26,80)," ")'="" D SET("!?25",$E(RCCOM,26,80),.PCT)
. . . D SET("!?45","ADDED BY USER: "_$P(RCCHIS(RCSUB),U,2),.PCT)
. . . D SET("!?45","ADDED: "_$P(RCCHIS(RCSUB),U,1),.PCT)
. . ;PRCA*4.5*321 - END
. ;
. 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPE215 10588 printed Apr 09, 2024@20:46:19 Page 2
RCDPE215 ;ALB/TMK- SF215 EDI Lockbox Summary Report ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,173,220,321**;Mar 20, 1995;Build 48
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
SUMM215 ; summary 215
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 NEW %,%ZIS,POP,RCDEPTDA,RCTYPE,DIC,X,Y,ZTSAVE,ZTDESC,ZTSK,ZTRTN
+5 ;
+6 SET DIC(0)="AEMQ"
SET DIC="^RCY(344.1,"
SET DIC("A")="Select DEPOSIT: "
+7 DO ^DIC
KILL DIC
+8 IF Y'>0
QUIT
+9 SET RCDEPTDA=+Y
+10 SET RCTYPE=$$GETTYPE^RCDPR215
+11 IF RCTYPE=""
QUIT
+12 ;
+13 ; device
+14 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
+15 IF $DATA(IO("Q"))
Begin DoDot:1
+16 SET ZTDESC="Print Summary 215 Report"
SET ZTRTN="DQ^RCDPE215"
+17 SET ZTSAVE("RCDEPTDA")=""
SET ZTSAVE("RCTYPE")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO ^%ZISC
QUIT
+18 WRITE !!,"<*> please wait <*>"
+19 DO DQ
+20 QUIT
+21 ;
DQ ; queued report entrypoint
+1 ; RCDEPTDA = ien of the deposit to summarize
+2 ; RCTYPE="D"etail or "A"ccrual
+3 NEW %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
+4 ;
+5 ; calculate report
+6 KILL ^TMP($JOB,"RCFMSCR"),^TMP($JOB,"RCFMSCR_SUM"),^TMP($JOB,"RCDPR215"),^TMP($JOB,"RCDET")
+7 SET EFTFUND=$SELECT(DT<$$ADDPTEDT^PRCAACC():"5287.4/8NZZ",1:"528704/8NZZ")
+8 SET DEPOSIT=$PIECE($GET(^RCY(344.1,RCDEPTDA,0)),U)
+9 SET RECEIPDA=0
FOR
SET RECEIPDA=$ORDER(^RCY(344,"AD",RCDEPTDA,RECEIPDA))
if 'RECEIPDA
QUIT
Begin DoDot:1
+10 DO FMSLINES^RCXFMSC1(RECEIPDA)
+11 ; sort by Receipt #
+12 SET ^TMP($JOB,"RCFMSCR_SUM",RECEIPDA)=""
+13 MERGE ^TMP($JOB,"RCFMSCR_SUM",RECEIPDA)=^TMP($JOB,"RCFMSCR")
+14 KILL ^TMP($JOB,"RCFMSCR")
+15 ; EFT dep receipt
IF $$EDILB^RCDPEU(RECEIPDA)=1
Begin DoDot:2
+16 SET TOT=0
+17 SET Z=0
FOR
SET Z=$ORDER(^RCY(344,RECEIPDA,1,Z))
if 'Z
QUIT
SET TOT=TOT+$PIECE($GET(^(Z,0)),U,4)
+18 SET (^TMP($JOB,"RCFMSCR_SUM",RECEIPDA,EFTFUND),^TMP($JOB,"RCTOT","EDILBOX"))=TOT
End DoDot:2
End DoDot:1
+19 ;
+20 ; summary rep for a deposit
+21 SET PAGE=0
SET RCYLINE=""
SET $PIECE(RCYLINE,"-",81)=""
+22 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
+23 SET SCREEN=0
IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET SCREEN=1
+24 USE IO
+25 KILL ^TMP($JOB,"RCTOT")
+26 SET RCDETAIL=1
SET PCT=0
SET EDITOT=0
+27 SET RECEIPDA=0
FOR
SET RECEIPDA=$ORDER(^TMP($JOB,"RCFMSCR_SUM",RECEIPDA))
if 'RECEIPDA
QUIT
Begin DoDot:1
+28 SET DATA=$GET(^RCY(344,RECEIPDA,0))
+29 SET RECEIPT=$PIECE(DATA,"^")
+30 SET FMSDOCNO=$PIECE($GET(^RCY(344.1,+$PIECE(DATA,"^",6),2)),"^")
+31 DO SET("<NP>",RECEIPT_"@"_FMSDOCNO_"@"_RECEIPDA,.PCT)
+32 ;
+33 ; stores printotal^inttotal^admintotal^marshtotal^cctotal
SET TOTAL=""
+34 ;
+35 SET FUND=""
FOR
SET FUND=$ORDER(^TMP($JOB,"RCFMSCR_SUM",RECEIPDA,FUND))
if 'FUND
QUIT
Begin DoDot:2
+36 DO SET("!!?5","Appropriation: "_FUND,.PCT)
+37 IF RCTYPE="D"
DO SET("!","",.PCT)
+38 ;
+39 SET PRINTOTL=0
+40 SET COUNT=0
+41 IF FUND=EFTFUND
SET PRINTOTL=PRINTOTL+$GET(^TMP($JOB,"RCFMSCR_SUM",RECEIPDA,FUND))
SET EDITOT=EDITOT+$GET(^TMP($JOB,"RCFMSCR_SUM",RECEIPDA,FUND))
+42 SET BILLDA=0
FOR
SET BILLDA=$ORDER(^TMP($JOB,"RCFMSCR_SUM",RECEIPDA,FUND,BILLDA))
if 'BILLDA
QUIT
Begin DoDot:3
+43 SET COUNT=COUNT+1
+44 SET BILL=$PIECE($GET(^PRCA(430,BILLDA,0)),"^")
+45 SET DATA=^TMP($JOB,"RCFMSCR_SUM",RECEIPDA,FUND,BILLDA)
+46 SET PRINTOTL=PRINTOTL+$PIECE(DATA,"^")
+47 FOR PIECE=1:1:5
SET $PIECE(TOTAL,"^",PIECE)=$PIECE(TOTAL,"^",PIECE)+$PIECE(DATA,"^",PIECE)
SET $PIECE(^TMP($JOB,"RCTOT","TOTAL"),"^",PIECE)=$PIECE($GET(^TMP($JOB,"RCTOT","TOTAL")),"^",PIECE)+$PIECE(DATA,"^",PIECE)
+48 ; if accrued report,no detail
+49 IF RCTYPE="A"
QUIT
+50 ;
+51 DO SET("!?5",COUNT_")",.PCT)
DO SET("?10",BILL,.PCT)
DO SET("?30",$JUSTIFY($PIECE(DATA,"^"),10,2),.PCT)
DO SET("?45","DEBTOR: "_$EXTRACT($$DEBTOR^RCDPR215(BILLDA),1,25),.PCT)
+52 DO SET("!?15","INT:"_$JUSTIFY($PIECE(DATA,"^",2),10,2)_" ADMIN:"_$JUSTIFY($PIECE(DATA,"^",3),10,2)_" MARS: "_$JUSTIFY($PIECE(DATA,"^",4),10,2)_" CC: "_$JUSTIFY($PIECE(DATA,"^",5),10,2),.PCT,1)
End DoDot:3
+53 ;
+54 IF RCTYPE="D"
DO SET("!?30","----------",.PCT)
DO SET("!?5","TOTAL for "_FUND,.PCT)
+55 DO SET("?30",$JUSTIFY(PRINTOTL,10,2),.PCT)
+56 IF FUND="0160a1"
DO SET("?45","0160a1 sub-totals Champva receipts",.PCT)
DO SET("!?45","not sent to FMS on the CR document.",.PCT)
+57 SET ^TMP($JOB,"RCTOT","PRINTOTL",FUND)=$GET(^TMP($JOB,"RCTOT","PRINTOTL",FUND))+PRINTOTL
+58 IF FUND=EFTFUND
SET $PIECE(^TMP($JOB,"RCTOT","TOTAL"),U)=$PIECE($GET(^TMP($JOB,"RCTOT","TOTAL")),U)+PRINTOTL
End DoDot:2
+59 ;
+60 ; show int, admin, etc receipt totals
+61 DO SET("!","",.PCT)
+62 DO SET("!?5","INTEREST : (APP: 1435)",.PCT)
DO SET("?30",$JUSTIFY($PIECE(TOTAL,"^",2),10,2),.PCT)
+63 DO SET("!?5","ADMIN : (APP: 3220)",.PCT)
DO SET("?30",$JUSTIFY($PIECE(TOTAL,"^",3),10,2),.PCT)
+64 DO SET("!?5","MARSHALL : (APP: 0869)",.PCT)
DO SET("?30",$JUSTIFY($PIECE(TOTAL,"^",4),10,2),.PCT)
+65 DO SET("!?5","COURTCOST: (APP: 0869)",.PCT)
DO SET("?30",$JUSTIFY($PIECE(TOTAL,"^",5),10,2),.PCT)
+66 DO SET("!?30","----------",.PCT)
+67 DO SET("!?30",$JUSTIFY($PIECE(TOTAL,"^",2)+$PIECE(TOTAL,"^",3)+$PIECE(TOTAL,"^",4)+$PIECE(TOTAL,"^",5),10,2),.PCT)
+68 ;
+69 IF $GET(^TMP($JOB,"RCFMSCR_SUM",RECEIPDA,EFTFUND))
SET $PIECE(TOTAL,U)=$PIECE(TOTAL,U)+^TMP($JOB,"RCFMSCR_SUM",RECEIPDA,EFTFUND)
+70 DO SUSP(RECEIPDA,RCTYPE,.TOTAL,.PCT)
+71 ;
+72 SET TOTLAMT=0
FOR PIECE=1:1:5
SET TOTLAMT=TOTLAMT+$PIECE(TOTAL,"^",PIECE)
+73 DO SET("!!","TOTALS: ",.PCT)
+74 DO SET("!?5","TOTAL AMT POSTED FOR RECEIPT:",.PCT)
DO SET("?30",$JUSTIFY(TOTLAMT,10,2),.PCT,1)
End DoDot:1
+75 ;
+76 DO H
+77 WRITE !!,"**** GRAND TOTALS FOR DEPOSIT: "_$PIECE($GET(^RCY(344.1,+RCDEPTDA,0)),U)
+78 SET TOT=0
+79 SET FUND=""
FOR
SET FUND=$ORDER(^TMP($JOB,"RCTOT","PRINTOTL",FUND))
if FUND=""
QUIT
Begin DoDot:1
+80 WRITE !!?5,"Appropriation: ",FUND,": ",?35,$JUSTIFY($GET(^TMP($JOB,"RCTOT","PRINTOTL",FUND)),10,2)
+81 SET TOT=TOT+$GET(^TMP($JOB,"RCTOT","PRINTOTL",FUND))
End DoDot:1
+82 WRITE !,?35,"=============",!,"Total Appropriation: ",?35,$JUSTIFY(+TOT,10,2)
+83 IF FUND="0160a1"
WRITE ?47,"0160a1 sub-totals Champva receipts",!?47,"not sent to FMS on the CR doc."
+84 ;
+85 SET TOTAL=$GET(^TMP($JOB,"RCTOT","TOTAL"))
+86 WRITE !
+87 WRITE !?5,"INTEREST : (APP: 1435)",?35,$JUSTIFY($PIECE(TOTAL,"^",2),10,2)
+88 WRITE !?5,"ADMIN : (APP: 3220)",?35,$JUSTIFY($PIECE(TOTAL,"^",3),10,2)
+89 WRITE !?5,"MARSHALL : (APP: 0869)",?35,$JUSTIFY($PIECE(TOTAL,"^",4),10,2)
+90 WRITE !?5,"COURTCOST: (APP: 0869)",?35,$JUSTIFY($PIECE(TOTAL,"^",5),10,2)
+91 WRITE !?35,"----------"
+92 WRITE !?35,$JUSTIFY($PIECE(TOTAL,"^",2)+$PIECE(TOTAL,"^",3)+$PIECE(TOTAL,"^",4)+$PIECE(TOTAL,"^",5),10,2)
+93 IF $GET(^TMP($JOB,"RCTOT","SUSPENSE"))
WRITE !!?5,"Total Appropriation: 3875",?35,$JUSTIFY(^TMP($JOB,"RCTOT","SUSPENSE"),10,2)
+94 ;
+95 SET TOTLAMT=0
FOR PIECE=1:1:5
SET TOTLAMT=TOTLAMT+$PIECE(TOTAL,"^",PIECE)
+96 IF $GET(^TMP($JOB,"RCTOT","EDILBOX"))
SET TOTLAMT=TOTLAMT+^TMP($JOB,"RCTOT","EDILBOX")
+97 WRITE !!,"TOTALS: "
+98 WRITE !?5,"TOT AMT POSTED FOR DEPOSIT: ",?35,$JUSTIFY(+TOTLAMT,10,2)
+99 IF SCREEN
DO PAUSE
if $GET(RCSTFLAG)
GOTO Q
+100 NEW Q,W,T,NS
+101 SET W=""
+102 SET PCT=0
FOR
SET PCT=$ORDER(^TMP($JOB,"RCDET",PCT))
if 'PCT
QUIT
Begin DoDot:1
+103 SET Q=$PIECE($GET(^TMP($JOB,"RCDET",PCT)),U)
SET T=$PIECE($GET(^(PCT)),U,2)
SET NS=$PIECE($GET(^(PCT)),U,3)
+104 IF Q="<NP>"
Begin DoDot:2
+105 IF W'=""
WRITE @W
SET W=""
if SCREEN
DO PAUSE
if $GET(RCSTFLAG)
QUIT
+106 SET RECEIPT=$PIECE(T,"@")
SET FMSDOCNO=$PIECE(T,"@",2)
SET RECEIPDA=$PIECE(T,"@",3)
+107 DO H
DO H1(0)
End DoDot:2
QUIT
+108 IF $EXTRACT(Q)="!"
if W'=""
WRITE @W
SET W=""
+109 SET W=W_$SELECT(W="":"",1:",")_Q_$SELECT(Q'="":",",1:"")_""""_T_""""
+110 IF 'NS
IF $Y>(IOSL-6)
if SCREEN
DO PAUSE
IF '$GET(RCSTFLAG)
DO H
DO H1(1)
End DoDot:1
if $GET(RCSTFLAG)
GOTO Q
+111 IF W'=""
WRITE @W
SET W=""
+112 IF SCREEN
WRITE !,"Press RETURN to continue: "
READ X:DTIME
+113 ;
Q DO ^%ZISC
+1 KILL ^TMP($JOB,"RCFMSCR"),^TMP($JOB,"RCDPR215"),^TMP($JOB,"RCTOT"),^TMP($JOB,"RCFMSCR_SUM"),^TMP($JOB,"RCDET")
+2 QUIT
+3 ;
+4 ;
SUSP(RECEIPDA,RCTYPE,TOTAL,PCT) ; unapplied amts for suspense
+1 ; RCTYPE = see explanation at DQ above
+2 ; Returns PCT,TOTAL if passed by reference
+3 ;
+4 NEW DA,AMOUNT,UNAPPLY,COUNT,PRINTOTL,COMMENTS
+5 KILL ^TMP($JOB,"RCDPR215")
+6 SET DA=0
FOR
SET DA=$ORDER(^RCY(344,RECEIPDA,1,DA))
if 'DA
QUIT
Begin DoDot:1
+7 SET AMOUNT=$PIECE($GET(^RCY(344,RECEIPDA,1,DA,0)),"^",4)
IF 'AMOUNT
QUIT
+8 SET UNAPPLY=$PIECE($GET(^RCY(344,RECEIPDA,1,DA,2)),"^",5)
IF UNAPPLY=""
QUIT
+9 ; if amount has not been processed, show it in suspense
+10 IF '$PIECE(^RCY(344,RECEIPDA,1,DA,0),"^",5)
SET ^TMP($JOB,"RCDPR215",DA)=UNAPPLY_"^"_AMOUNT_"^"_$PIECE($GET(^RCY(344,RECEIPDA,1,DA,1)),"^",2)
End DoDot:1
+11 ;
+12 IF $ORDER(^TMP($JOB,"RCDPR215",0))
Begin DoDot:1
+13 DO SET("!!?5","Appropriation: 3875",.PCT)
+14 IF RCTYPE="D"
DO SET("!","",.PCT)
+15 ;
+16 SET COUNT=0
SET PRINTOTL=0
+17 SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,"RCDPR215",DA))
if 'DA!($GET(RCSTFLAG))
QUIT
Begin DoDot:2
+18 ;
+19 SET UNAPPLY=$PIECE(^TMP($JOB,"RCDPR215",DA),"^")
SET AMOUNT=$PIECE(^(DA),"^",2)
SET COMMENTS=$PIECE(^(DA),"^",3)
+20 SET PRINTOTL=PRINTOTL+AMOUNT
+21 SET $PIECE(TOTAL,"^")=$PIECE(TOTAL,"^")+AMOUNT
+22 ; no detail if accrued report
+23 IF RCTYPE="A"
QUIT
+24 ;
+25 SET COUNT=COUNT+1
+26 DO SET("!?5",COUNT_")",.PCT)
DO SET("?10",UNAPPLY,.PCT)
DO SET("?30",$JUSTIFY(AMOUNT,10,2),.PCT)
DO SET("?45","COMMENTS: "_$EXTRACT(COMMENTS,1,25),.PCT)
+27 IF $TRANSLATE($EXTRACT(COMMENTS,26,80)," ")'=""
DO SET("!?25",$EXTRACT(COMMENTS,26,80),.PCT)
+28 ;PRCA*4.5*321 - BEGIN
+29 ; Get comment history from RCDPE COMMENT HISTORY file #344.73
+30 NEW RCCHIS,RCCOM,RCSUB
+31 DO GET^RCDPECH(.RCCHIS,RECEIPDA,DA)
+32 SET RCSUB=0
+33 FOR
SET RCSUB=$ORDER(RCCHIS(RCSUB))
if 'RCSUB
QUIT
Begin DoDot:3
+34 IF RCSUB>1
Begin DoDot:4
+35 SET RCCOM=$PIECE(RCCHIS(RCSUB),U,3)
+36 DO SET("!?45","COMMENTS: "_$EXTRACT(RCCOM,1,25),.PCT)
+37 IF $TRANSLATE($EXTRACT(RCCOM,26,80)," ")'=""
DO SET("!?25",$EXTRACT(RCCOM,26,80),.PCT)
End DoDot:4
+38 DO SET("!?45","ADDED BY USER: "_$PIECE(RCCHIS(RCSUB),U,2),.PCT)
+39 DO SET("!?45","ADDED: "_$PIECE(RCCHIS(RCSUB),U,1),.PCT)
End DoDot:3
+40 ;PRCA*4.5*321 - END
End DoDot:2
+41 ;
+42 SET $PIECE(^TMP($JOB,"RCTOT","TOTAL"),U)=($PIECE($GET(^TMP($JOB,"RCTOT","TOTAL")),U)+PRINTOTL)
+43 IF RCTYPE="D"
DO SET("!?30","----------",.PCT)
DO SET("!?5","TOTAL for 3875",.PCT)
+44 DO SET("?30",$JUSTIFY(PRINTOTL,10,2),.PCT)
+45 SET ^TMP($JOB,"RCTOT","SUSPENSE")=$GET(^TMP($JOB,"RCTOT","SUSPENSE"))+PRINTOTL
End DoDot:1
+46 QUIT
+47 ;
+48 ;
GETTYPE() ; ask type of report to print
+1 NEW DIR,X,Y
+2 SET DIR(0)="S^A:ACCRUED;D:DETAILED"
SET DIR("A")="ACCRUED OR DETAILED REPORT"
SET DIR("B")="ACCRUED"
SET DIR("?")="A DETAILED Report will list out accrued bills separately"
+3 SET DIR("?",1)="An ACCRUED Report will list just the accrued total under each appropriation"
+4 DO ^DIR
+5 IF Y'="A"
IF Y'="D"
QUIT ""
+6 QUIT Y
+7 ;
+8 ;
H ; Deposit hdr
+1 NEW Z
+2 SET PAGE=PAGE+1
IF PAGE'=1!(SCREEN)
WRITE @IOF
+3 WRITE $CHAR(13),"Page ",PAGE,?(80-$LENGTH(NOW)),NOW
+4 WRITE !,$EXTRACT($TRANSLATE(RCYLINE,"-","*"),1,26)," 215 DEPOSIT SUMMARY REPORT ",$EXTRACT($TRANSLATE(RCYLINE,"-","*"),1,26)
+5 WRITE !!,"DEPOSIT #: ",DEPOSIT
+6 WRITE !,RCYLINE
+7 QUIT
+8 ;
H1(CONT) ; Receipt Hdr
+1 ; CONT = 1 if continuation from previous page
+2 ;
+3 NEW Z
+4 WRITE !!,"RECEIPT #: "_RECEIPT_$SELECT($GET(CONT):" (continued)",1:"")
+5 IF FMSDOCNO'=""
WRITE ?51,"FMS Document #: ",FMSDOCNO
+6 SET Z=""
SET $PIECE(Z,"-",$LENGTH(RECEIPT)+1)=""
+7 WRITE !,?11,Z
+8 SET Z=""
+9 IF $PIECE($GET(^RCY(344,RECEIPDA,0)),U,18)
SET Z=$EXTRACT(" REFERENCE ERA #: "_$PIECE($GET(^RCY(344.4,+$PIECE($GET(^RCY(344,RECEIPDA,0)),U,18),0)),U)_" ("_$PIECE($GET(^RCY(344.4,+$PIECE($GET(^RCY(344,RECEIPDA,0)),U,18),0)),U,2)_")"_$JUSTIFY("",51),1,51)
+10 IF Z'=""
WRITE !,Z
+11 WRITE !
+12 QUIT
+13 ;
+14 ;
PAUSE ;
+1 DO PAUSE^RCDPR215
+2 QUIT
+3 ;
SET(CTRL,TXT,PCT,NOSP) ; Sets print array for detail
+1 ;PCT = count of lines
+2 ;CTRL = Control characters
+3 ;TXT = text to print
+4 ;NOSP = 1 if line should always print with the previous line
+5 SET PCT=PCT+1
SET ^TMP($JOB,"RCDET",PCT)=CTRL_U_TXT_U_+$GET(NOSP)
+6 QUIT
+7 ;
