RCDPR215 ;WISC/RFJ-receipt processing sf215 report ;1 Jun 99
;;4.5;Accounts Receivable;**114,173,211,220,321,375**;Mar 20, 1995;Build 15
;;Per VHA Directive 6402, this routine should not be modified.
Q
;
DQ ; queued report starts here, input RECEIPDA
; RCTYPE="D"etail or "A"ccrual
N %I,AMOUNT,BILL,BILLDA,COMMENTS,COUNT,DA,DATA,DEPOSIT,DETAIL,FMSDOCNO,FUND,NOW,PAGE,PIECE,PRINTOTL,RCSTFLAG,RCYLINE,RECEIPT,SCREEN,TOTAL,TOTLAMT,UNAPPLY,X,Y,TOT,%,REPRODT,EFTFUND
;
; calculate report
; input receipda (ien of receipt)
K ^TMP($J,"RCFMSCR"),^TMP($J,"RCDPR215")
S EFTFUND=$S(DT<$$ADDPTEDT^PRCAACC():"5287.4/8NZZ",1:"528704/8NZZ")
S REPRODT=$P($P($G(^RCY(344,RECEIPDA,0)),"^",8),".")
D FMSLINES^RCXFMSC1(RECEIPDA)
I $$EDILB^RCDPEU(RECEIPDA)=1 D ; EFT deposit receipt
. ;PRCA*4.5*375 - Present Debit CRs as Negative Values
. N AMT
. S TOT=0,AMT=0
. S Z=0 F S Z=$O(^RCY(344,RECEIPDA,1,Z)) Q:'Z D
.. S AMT=$P($G(^RCY(344,RECEIPDA,1,Z,0)),U,4)
.. S:$P($G(^RCY(344,RECEIPDA,1,Z,0)),U,29)="D" AMT=-AMT
.. S TOT=TOT+AMT
. ;END PRCA*4.5*375
. S ^TMP($J,"RCFMSCR",EFTFUND)=TOT
;
; print report
S DATA=$G(^RCY(344,RECEIPDA,0))
S RECEIPT=$P(DATA,"^")
S DEPOSIT=$P($G(^RCY(344.1,+$P(DATA,"^",6),0)),"^")
S FMSDOCNO=$P($G(^RCY(344.1,+$P(DATA,"^",6),2)),"^")
;
D NOW^%DTC S Y=% D DD^%DT S NOW=Y
S PAGE=0,RCYLINE="",$P(RCYLINE,"-",81)=""
S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
U IO D H
;
S TOTAL="" ; stores printotal^inttotal^admintotal^marshtotal^cctotal
S FUND="" F S FUND=$O(^TMP($J,"RCFMSCR",FUND)) Q:'FUND!($G(RCSTFLAG)) D
. I $Y>(IOSL-6) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
. W !!?5,"Appropriation: ",FUND
. I RCTYPE="D" W !
. ;
. S PRINTOTL=0
. S COUNT=0
. I FUND=EFTFUND S PRINTOTL=PRINTOTL+$G(^TMP($J,"RCFMSCR",FUND))
. S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCFMSCR",FUND,BILLDA)) Q:'BILLDA!($G(RCSTFLAG)) D
. . I $Y>(IOSL-5) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
. . S COUNT=COUNT+1
. . S BILL=$P($G(^PRCA(430,BILLDA,0)),"^")
. . S DATA=^TMP($J,"RCFMSCR",FUND,BILLDA)
. . S PRINTOTL=PRINTOTL+$P(DATA,"^")
. . F PIECE=1:1:5 S $P(TOTAL,"^",PIECE)=$P(TOTAL,"^",PIECE)+$P(DATA,"^",PIECE)
. . ; if accrued report, do not show detail
. . I RCTYPE="A" Q
. . ;
. . W !?5,COUNT,")",?10,BILL,?30,$J($P(DATA,"^"),10,2),?45,"DEBTOR: ",$E($$DEBTOR(BILLDA),1,25)
. . W !?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)
. ;
. I $G(RCSTFLAG) Q
. I RCTYPE="D" W !?30,"----------",!?5,"TOTAL for ",FUND
. W ?30,$J(PRINTOTL,10,2)
. I FUND="0160a1" W ?45,"0160a1 sub-totals Champva receipts",!?45,"not sent to FMS on the CR document."
;
I $G(RCSTFLAG) D Q Q
I $Y>(IOSL-6) D:SCREEN PAUSE I '$G(RCSTFLAG) D H
I $G(RCSTFLAG) D Q Q
;
; show int, admin, etc totals
W !
W !?5,"INTEREST : (APP: 1435)",?30,$J($P(TOTAL,"^",2),10,2)
W !?5,"ADMIN : (APP: 3220)",?30,$J($P(TOTAL,"^",3),10,2)
W !?5,"MARSHALL : (APP: 0869)",?30,$J($P(TOTAL,"^",4),10,2)
W !?5,"COURTCOST: (APP: 0869)",?30,$J($P(TOTAL,"^",5),10,2)
W !?30,"----------"
W !?30,$J($P(TOTAL,"^",2)+$P(TOTAL,"^",3)+$P(TOTAL,"^",4)+$P(TOTAL,"^",5),10,2)
;
I $Y>(IOSL-8) D:SCREEN PAUSE I '$G(RCSTFLAG) D H
I $G(RCSTFLAG) D Q Q
;
I $G(^TMP($J,"RCFMSCR",EFTFUND)) S $P(TOTAL,U)=$P(TOTAL,U)+^TMP($J,"RCFMSCR",EFTFUND)
; compile unapplied amounts that went to suspense
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)
;
; print unapplied amounts that went to suspense
I $O(^TMP($J,"RCDPR215",0)) D
. W !!?5,"Appropriation: 3875"
. I RCTYPE="D" W !
. ;
. S COUNT=0,PRINTOTL=0
. S DA=0 F S DA=$O(^TMP($J,"RCDPR215",DA)) Q:'DA!($G(RCSTFLAG)) D
. . I $Y>(IOSL-6) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
. . ;
. . 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
. . ; if accrued report, do not show detail
. . I RCTYPE="A" Q
. . ;
. . S COUNT=COUNT+1
. . W !?5,COUNT,")",?10,UNAPPLY,?30,$J(AMOUNT,10,2),?45,"COMMENTS: ",$E(COMMENTS,1,25)
. . I $TR($E(COMMENTS,26,80)," ")'="" W !?25,$E(COMMENTS,26,80)
. . ;PRCA*4.5*321 - BEGIN
. . ; Get comment history from RCDPE COMMENT HISTORY file #344.73
. . N RCCHIS,RCSUB,RCCOM
. . 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)
. . . . I $Y>(IOSL-6) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
. . . . W !,?45,"COMMENTS: "_$E(RCCOM,1,25)
. . . . Q:$TR($E(RCCOM,26,80)," ")=""
. . . . I $Y>(IOSL-6) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
. . . . W !?25,$E(RCCOM,26,80)
. . . I RCSUB>1,$Y>(IOSL-6) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
. . . W !,?45,"ADDED BY USER: "_$P(RCCHIS(RCSUB),U,2)
. . . I $Y>(IOSL-6) D:SCREEN PAUSE Q:$G(RCSTFLAG) D H
. . . W !,?45,"ADDED: "_$P(RCCHIS(RCSUB),U,1)
. . ;PRCA*4.5*321 - END
. ;
. I $G(RCSTFLAG) Q
. I RCTYPE="D" W !?30,"----------",!?5,"TOTAL for 3875"
. W ?30,$J(PRINTOTL,10,2)
I $G(RCSTFLAG) D Q Q
;
S TOTLAMT=0 F PIECE=1:1:5 S TOTLAMT=TOTLAMT+$P(TOTAL,"^",PIECE)
W !!,"TOTALS: "
W !?5,"TOTAL AMOUNT POSTED:",?30,$J(TOTLAMT,10,2)
;
I SCREEN W !,"Press RETURN to continue: " R X:DTIME
Q D ^%ZISC
K ^TMP($J,"RCFMSCR"),^TMP($J,"RCDPR215")
Q
;
;
GETTYPE() ; ask the 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
;
;
DEBTOR(DA) ; returns the debtor name for ien of bill (da) in file 430
N D0,DEBTOR,DIC,DIQ,DR
S DIC="^PRCA(430,",DR=9,DIQ(0)="E",DIQ="DEBTOR"
D EN^DIQ1
Q $G(DEBTOR(430,DA,9,"E"))
;
;
H ; header
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,34)," 215 REPORT ",$E($TR(RCYLINE,"-","*"),1,34)
W !!,"RECEIPT #: ",RECEIPT,?25,"for DEPOSIT #: ",DEPOSIT
I FMSDOCNO'="" W ?51,"FMS Document #: ",FMSDOCNO
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 !,RCYLINE
Q
;
;
PAUSE ; pause at end of page
N X U IO(0) W !,"Press RETURN to continue, '^' to exit:" R X:DTIME S:'$T X="^" S:X["^" RCSTFLAG=1 U IO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPR215 7228 printed Apr 09, 2024@20:48:19 Page 2
RCDPR215 ;WISC/RFJ-receipt processing sf215 report ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,173,211,220,321,375**;Mar 20, 1995;Build 15
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
DQ ; queued report starts here, input RECEIPDA
+1 ; RCTYPE="D"etail or "A"ccrual
+2 NEW %I,AMOUNT,BILL,BILLDA,COMMENTS,COUNT,DA,DATA,DEPOSIT,DETAIL,FMSDOCNO,FUND,NOW,PAGE,PIECE,PRINTOTL,RCSTFLAG,RCYLINE,RECEIPT,SCREEN,TOTAL,TOTLAMT,UNAPPLY,X,Y,TOT,%,REPRODT,EFTFUND
+3 ;
+4 ; calculate report
+5 ; input receipda (ien of receipt)
+6 KILL ^TMP($JOB,"RCFMSCR"),^TMP($JOB,"RCDPR215")
+7 SET EFTFUND=$SELECT(DT<$$ADDPTEDT^PRCAACC():"5287.4/8NZZ",1:"528704/8NZZ")
+8 SET REPRODT=$PIECE($PIECE($GET(^RCY(344,RECEIPDA,0)),"^",8),".")
+9 DO FMSLINES^RCXFMSC1(RECEIPDA)
+10 ; EFT deposit receipt
IF $$EDILB^RCDPEU(RECEIPDA)=1
Begin DoDot:1
+11 ;PRCA*4.5*375 - Present Debit CRs as Negative Values
+12 NEW AMT
+13 SET TOT=0
SET AMT=0
+14 SET Z=0
FOR
SET Z=$ORDER(^RCY(344,RECEIPDA,1,Z))
if 'Z
QUIT
Begin DoDot:2
+15 SET AMT=$PIECE($GET(^RCY(344,RECEIPDA,1,Z,0)),U,4)
+16 if $PIECE($GET(^RCY(344,RECEIPDA,1,Z,0)),U,29)="D"
SET AMT=-AMT
+17 SET TOT=TOT+AMT
End DoDot:2
+18 ;END PRCA*4.5*375
+19 SET ^TMP($JOB,"RCFMSCR",EFTFUND)=TOT
End DoDot:1
+20 ;
+21 ; print report
+22 SET DATA=$GET(^RCY(344,RECEIPDA,0))
+23 SET RECEIPT=$PIECE(DATA,"^")
+24 SET DEPOSIT=$PIECE($GET(^RCY(344.1,+$PIECE(DATA,"^",6),0)),"^")
+25 SET FMSDOCNO=$PIECE($GET(^RCY(344.1,+$PIECE(DATA,"^",6),2)),"^")
+26 ;
+27 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
+28 SET PAGE=0
SET RCYLINE=""
SET $PIECE(RCYLINE,"-",81)=""
+29 SET SCREEN=0
IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET SCREEN=1
+30 USE IO
DO H
+31 ;
+32 ; stores printotal^inttotal^admintotal^marshtotal^cctotal
SET TOTAL=""
+33 SET FUND=""
FOR
SET FUND=$ORDER(^TMP($JOB,"RCFMSCR",FUND))
if 'FUND!($GET(RCSTFLAG))
QUIT
Begin DoDot:1
+34 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE
if $GET(RCSTFLAG)
QUIT
DO H
+35 WRITE !!?5,"Appropriation: ",FUND
+36 IF RCTYPE="D"
WRITE !
+37 ;
+38 SET PRINTOTL=0
+39 SET COUNT=0
+40 IF FUND=EFTFUND
SET PRINTOTL=PRINTOTL+$GET(^TMP($JOB,"RCFMSCR",FUND))
+41 SET BILLDA=0
FOR
SET BILLDA=$ORDER(^TMP($JOB,"RCFMSCR",FUND,BILLDA))
if 'BILLDA!($GET(RCSTFLAG))
QUIT
Begin DoDot:2
+42 IF $Y>(IOSL-5)
if SCREEN
DO PAUSE
if $GET(RCSTFLAG)
QUIT
DO H
+43 SET COUNT=COUNT+1
+44 SET BILL=$PIECE($GET(^PRCA(430,BILLDA,0)),"^")
+45 SET DATA=^TMP($JOB,"RCFMSCR",FUND,BILLDA)
+46 SET PRINTOTL=PRINTOTL+$PIECE(DATA,"^")
+47 FOR PIECE=1:1:5
SET $PIECE(TOTAL,"^",PIECE)=$PIECE(TOTAL,"^",PIECE)+$PIECE(DATA,"^",PIECE)
+48 ; if accrued report, do not show detail
+49 IF RCTYPE="A"
QUIT
+50 ;
+51 WRITE !?5,COUNT,")",?10,BILL,?30,$JUSTIFY($PIECE(DATA,"^"),10,2),?45,"DEBTOR: ",$EXTRACT($$DEBTOR(BILLDA),1,25)
+52 WRITE !?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)
End DoDot:2
+53 ;
+54 IF $GET(RCSTFLAG)
QUIT
+55 IF RCTYPE="D"
WRITE !?30,"----------",!?5,"TOTAL for ",FUND
+56 WRITE ?30,$JUSTIFY(PRINTOTL,10,2)
+57 IF FUND="0160a1"
WRITE ?45,"0160a1 sub-totals Champva receipts",!?45,"not sent to FMS on the CR document."
End DoDot:1
+58 ;
+59 IF $GET(RCSTFLAG)
DO Q
QUIT
+60 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE
IF '$GET(RCSTFLAG)
DO H
+61 IF $GET(RCSTFLAG)
DO Q
QUIT
+62 ;
+63 ; show int, admin, etc totals
+64 WRITE !
+65 WRITE !?5,"INTEREST : (APP: 1435)",?30,$JUSTIFY($PIECE(TOTAL,"^",2),10,2)
+66 WRITE !?5,"ADMIN : (APP: 3220)",?30,$JUSTIFY($PIECE(TOTAL,"^",3),10,2)
+67 WRITE !?5,"MARSHALL : (APP: 0869)",?30,$JUSTIFY($PIECE(TOTAL,"^",4),10,2)
+68 WRITE !?5,"COURTCOST: (APP: 0869)",?30,$JUSTIFY($PIECE(TOTAL,"^",5),10,2)
+69 WRITE !?30,"----------"
+70 WRITE !?30,$JUSTIFY($PIECE(TOTAL,"^",2)+$PIECE(TOTAL,"^",3)+$PIECE(TOTAL,"^",4)+$PIECE(TOTAL,"^",5),10,2)
+71 ;
+72 IF $Y>(IOSL-8)
if SCREEN
DO PAUSE
IF '$GET(RCSTFLAG)
DO H
+73 IF $GET(RCSTFLAG)
DO Q
QUIT
+74 ;
+75 IF $GET(^TMP($JOB,"RCFMSCR",EFTFUND))
SET $PIECE(TOTAL,U)=$PIECE(TOTAL,U)+^TMP($JOB,"RCFMSCR",EFTFUND)
+76 ; compile unapplied amounts that went to suspense
+77 SET DA=0
FOR
SET DA=$ORDER(^RCY(344,RECEIPDA,1,DA))
if 'DA
QUIT
Begin DoDot:1
+78 SET AMOUNT=$PIECE($GET(^RCY(344,RECEIPDA,1,DA,0)),"^",4)
IF 'AMOUNT
QUIT
+79 SET UNAPPLY=$PIECE($GET(^RCY(344,RECEIPDA,1,DA,2)),"^",5)
IF UNAPPLY=""
QUIT
+80 ; if amount has not been processed, show it in suspense
+81 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
+82 ;
+83 ; print unapplied amounts that went to suspense
+84 IF $ORDER(^TMP($JOB,"RCDPR215",0))
Begin DoDot:1
+85 WRITE !!?5,"Appropriation: 3875"
+86 IF RCTYPE="D"
WRITE !
+87 ;
+88 SET COUNT=0
SET PRINTOTL=0
+89 SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,"RCDPR215",DA))
if 'DA!($GET(RCSTFLAG))
QUIT
Begin DoDot:2
+90 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE
if $GET(RCSTFLAG)
QUIT
DO H
+91 ;
+92 SET UNAPPLY=$PIECE(^TMP($JOB,"RCDPR215",DA),"^")
SET AMOUNT=$PIECE(^(DA),"^",2)
SET COMMENTS=$PIECE(^(DA),"^",3)
+93 SET PRINTOTL=PRINTOTL+AMOUNT
+94 SET $PIECE(TOTAL,"^")=$PIECE(TOTAL,"^")+AMOUNT
+95 ; if accrued report, do not show detail
+96 IF RCTYPE="A"
QUIT
+97 ;
+98 SET COUNT=COUNT+1
+99 WRITE !?5,COUNT,")",?10,UNAPPLY,?30,$JUSTIFY(AMOUNT,10,2),?45,"COMMENTS: ",$EXTRACT(COMMENTS,1,25)
+100 IF $TRANSLATE($EXTRACT(COMMENTS,26,80)," ")'=""
WRITE !?25,$EXTRACT(COMMENTS,26,80)
+101 ;PRCA*4.5*321 - BEGIN
+102 ; Get comment history from RCDPE COMMENT HISTORY file #344.73
+103 NEW RCCHIS,RCSUB,RCCOM
+104 DO GET^RCDPECH(.RCCHIS,RECEIPDA,DA)
+105 SET RCSUB=0
+106 FOR
SET RCSUB=$ORDER(RCCHIS(RCSUB))
if 'RCSUB
QUIT
Begin DoDot:3
+107 IF RCSUB>1
Begin DoDot:4
+108 SET RCCOM=$PIECE(RCCHIS(RCSUB),U,3)
+109 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE
if $GET(RCSTFLAG)
QUIT
DO H
+110 WRITE !,?45,"COMMENTS: "_$EXTRACT(RCCOM,1,25)
+111 if $TRANSLATE($EXTRACT(RCCOM,26,80)," ")=""
QUIT
+112 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE
if $GET(RCSTFLAG)
QUIT
DO H
+113 WRITE !?25,$EXTRACT(RCCOM,26,80)
End DoDot:4
+114 IF RCSUB>1
IF $Y>(IOSL-6)
if SCREEN
DO PAUSE
if $GET(RCSTFLAG)
QUIT
DO H
+115 WRITE !,?45,"ADDED BY USER: "_$PIECE(RCCHIS(RCSUB),U,2)
+116 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE
if $GET(RCSTFLAG)
QUIT
DO H
+117 WRITE !,?45,"ADDED: "_$PIECE(RCCHIS(RCSUB),U,1)
End DoDot:3
+118 ;PRCA*4.5*321 - END
End DoDot:2
+119 ;
+120 IF $GET(RCSTFLAG)
QUIT
+121 IF RCTYPE="D"
WRITE !?30,"----------",!?5,"TOTAL for 3875"
+122 WRITE ?30,$JUSTIFY(PRINTOTL,10,2)
End DoDot:1
+123 IF $GET(RCSTFLAG)
DO Q
QUIT
+124 ;
+125 SET TOTLAMT=0
FOR PIECE=1:1:5
SET TOTLAMT=TOTLAMT+$PIECE(TOTAL,"^",PIECE)
+126 WRITE !!,"TOTALS: "
+127 WRITE !?5,"TOTAL AMOUNT POSTED:",?30,$JUSTIFY(TOTLAMT,10,2)
+128 ;
+129 IF SCREEN
WRITE !,"Press RETURN to continue: "
READ X:DTIME
Q DO ^%ZISC
+1 KILL ^TMP($JOB,"RCFMSCR"),^TMP($JOB,"RCDPR215")
+2 QUIT
+3 ;
+4 ;
GETTYPE() ; ask the 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 ;
DEBTOR(DA) ; returns the debtor name for ien of bill (da) in file 430
+1 NEW D0,DEBTOR,DIC,DIQ,DR
+2 SET DIC="^PRCA(430,"
SET DR=9
SET DIQ(0)="E"
SET DIQ="DEBTOR"
+3 DO EN^DIQ1
+4 QUIT $GET(DEBTOR(430,DA,9,"E"))
+5 ;
+6 ;
H ; header
+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,34)," 215 REPORT ",$EXTRACT($TRANSLATE(RCYLINE,"-","*"),1,34)
+5 WRITE !!,"RECEIPT #: ",RECEIPT,?25,"for DEPOSIT #: ",DEPOSIT
+6 IF FMSDOCNO'=""
WRITE ?51,"FMS Document #: ",FMSDOCNO
+7 SET Z=""
+8 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)
+9 IF Z'=""
WRITE !,Z
+10 WRITE !,RCYLINE
+11 QUIT
+12 ;
+13 ;
PAUSE ; pause at end of page
+1 NEW X
USE IO(0)
WRITE !,"Press RETURN to continue, '^' to exit:"
READ X:DTIME
if '$TEST
SET X="^"
if X["^"
SET RCSTFLAG=1
USE IO
+2 QUIT
