Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPE215

RCDPE215.m

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