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

RCDPLPS1.m

Go to the documentation of this file.
  1. RCDPLPS1 ;ALB/SAB - Link Payments Suspense Report ;2/22/16
  1. ;;4.5;Accounts Receivable;**304**;Mar 20, 1995;Build 104
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. REPORT ; report to show payments cleared from suspense in FMS
  1. ;
  1. N POP,ZTDESC,ZTRTN,ZTQUEUED,ZTSAVE,%
  1. D FULL^VALM1
  1. S VALMBCK="R"
  1. ;
  1. W !!,"This option will print a report showing all unlinked payments"
  1. W !,"received between selected dates that were processed to the station's"
  1. W !,"suspense account and later cleared by on-line FMS input.",!
  1. ;
  1. N DATEEND,DATESTRT
  1. D DATESEL^RCRJRTRA("PAYMENT")
  1. I '$G(DATESTRT)!('$G(DATEEND)) Q
  1. ;
  1. ; select device
  1. W ! S %ZIS="Q" D ^%ZIS I POP S VALMBCK="R" Q
  1. I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D ^%ZISC S VALMBCK="R" Q
  1. . S ZTDESC="AR Clear Suspense Payment Report",ZTRTN="DQ^RCDPLPS1"
  1. . S ZTSAVE("DATE*")="",ZTSAVE("ZTREQ")="@"
  1. W !!,"<*> please wait <*>"
  1. D DQ
  1. R !,"Press RETURN to continue:",%:DTIME
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ;
  1. DQ ; report (queue) starts here
  1. ;
  1. N %,DATA,DATE,DATEDIS1,DATEDIS2,NOW,PAGE,RCDATA,RCRECTDA,RCRJFLAG,RCRJLINE,RCTRANDA,RECDATA,SCREEN
  1. N AMT,CLAIM,DEP,FMSDOC,OSUSPBY,OSUSPDT,PROFILE,RCDATA2,RCDATA3,SUSPBY,SUSPDT,UNDEP,RCDEP,RCCLM
  1. K ^TMP("RCDPLPS1",$J)
  1. S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,RCRECTDA)) Q:'RCRECTDA D
  1. . S RECDATA=$G(^RCY(344,RCRECTDA,0))
  1. . S RCTRANDA=0 F S RCTRANDA=$O(^RCY(344,RCRECTDA,1,RCTRANDA)) Q:'RCTRANDA D
  1. . . S RCDATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
  1. . . S RCDATA2=$G(^RCY(344,RCRECTDA,1,RCTRANDA,2)) ; get account info
  1. . . S RCDATA3=$G(^RCY(344,RCRECTDA,1,RCTRANDA,3)) ; get suspense info
  1. . . S DATE=$P(RCDATA,U,6)
  1. . . I '$P(RCDATA,U,4) Q ;no payment amount
  1. . . ; never sent to suspense
  1. . . I $P(RCDATA2,U,5)="" Q
  1. . . ; fms doc id not entered (field 26) to clear suspense
  1. . . S FMSDOC=$P(RCDATA2,U,6) ; FMS doc
  1. . . I FMSDOC="" Q
  1. . . ; get payment date
  1. . . S DATE=$P(RCDATA,"^",6)
  1. . . I 'DATE S DATE=$P(RCDATA,"^",10)
  1. . . I 'DATE S DATE=$P(RECDATA,"^",3)
  1. . . I 'DATE S DATE=0
  1. . . S DATE=$P(DATE,".")
  1. . . I DATE<DATESTRT!(DATE>DATEEND) Q
  1. . . ;
  1. . . S UNDEP=$$GETUNAPP^RCXFMSCR(RCRECTDA,RCTRANDA,0) ; unapplied deposit
  1. . . S PROFILE=RCTRANDA ; profile/transaction #
  1. . . S SUSPDT=$P($$FMTE^XLFDT($P(RCDATA3,U,2),2),"@") ; date placed in suspense
  1. . . S SUSPBY=$$USERINIT($P(RCDATA3,U,3)) ; placed in suspense by
  1. . . S RCCLM=$P($P(RCDATA,U,9),";"),CLAIM=""
  1. . . S:RCCLM'="" CLAIM=$P($G(^PRCA(430,RCCLM,0)),U) ; claim number
  1. . . S OSUSPDT=$P($$FMTE^XLFDT($P(RCDATA3,U,4),2),"@") ; date placed out of suspense
  1. . . S OSUSPBY=$$USERINIT($P(RCDATA3,U,5)) ; placed out of suspense by
  1. . . S DEP=$P(RECDATA,U,6)
  1. . . S RCDEP="" S:DEP'="" RCDEP=$P($G(^RCY(344.1,DEP,0)),U) ; get the Dep#
  1. . . S AMT=$P(RCDATA,U,4) ; Amount cleared
  1. . . S ^TMP("RCDPLPS1",$J,DATE,RCRECTDA,RCTRANDA)=UNDEP_U_PROFILE_U_SUSPDT_U_SUSPBY_U_CLAIM_U_OSUSPDT_U_OSUSPBY_U_FMSDOC_U_AMT_U_RCDEP
  1. ;
  1. ; print report
  1. S Y=$P(DATESTRT,".") D DD^%DT S DATEDIS1=Y
  1. S Y=$P(DATEEND,".") D DD^%DT S DATEDIS2=Y
  1. D NOW^%DTC S Y=% D DD^%DT S NOW=Y
  1. S PAGE=1,RCRJLINE="",$P(RCRJLINE,"-",81)=""
  1. S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
  1. U IO D H
  1. S DATE=0 F S DATE=$O(^TMP("RCDPLPS1",$J,DATE)) Q:'DATE!($G(RCRJFLAG)) D
  1. . S RCRECTDA=0 F S RCRECTDA=$O(^TMP("RCDPLPS1",$J,DATE,RCRECTDA)) Q:'RCRECTDA!($G(RCRJFLAG)) D
  1. . . S RCTRANDA=0 F S RCTRANDA=$O(^TMP("RCDPLPS1",$J,DATE,RCRECTDA,RCTRANDA)) Q:'RCTRANDA!($G(RCRJFLAG)) D
  1. . . . S DATA=^TMP("RCDPLPS1",$J,DATE,RCRECTDA,RCTRANDA)
  1. . . . W !,$P(DATA,"^",10),?11,$J(RCTRANDA,5),?20,$P(DATA,"^",3),?29,$P(DATA,"^",4),?35,$P(DATA,"^",5),?51,$P(DATA,"^"),?67,$J($P(DATA,"^",9),10,2)
  1. . . . W !,?10,$P(DATA,"^",6),?20,$P(DATA,"^",7),?27,$P(DATA,"^",8)
  1. . . . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
  1. ;
  1. K ^TMP("RCDPLPS1",$J)
  1. D ^%ZISC
  1. Q
  1. ;
  1. ;
  1. H ; header
  1. N %
  1. S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
  1. W $C(13),"AR CLEARED SUSPENSE REPORT",?(80-$L(%)),%
  1. W !," FOR THE DATE RANGE: ",DATEDIS1," TO ",DATEDIS2
  1. W !,"DEPOSIT#0",?10,"PROFILE#",?20,"IN SUSP",?29,"IN BY",?35,"CLAIM#",?51,"UNAPP DEP#",?67,$J("AMOUNT",10)
  1. W !,?10,"OUT SUSP",?20,"OUT BY",?27,"CLEAR DOC ID#"
  1. W !,RCRJLINE
  1. Q
  1. ;
  1. ;
  1. MAILMSG(RCRECTDA,RCTRANDA) ; generate message to users showing what needs to be moved out
  1. ; of suspense to 5287
  1. N %Z,DATE,DDH,MESSAGE,X9,XCNP,XMDUZ,XMZ,X,Y,XMSUB,XMTEXT,XMY
  1. S DATE=$P($P($G(^RCY(344,RCRECTDA,0)),"^",8),".") I DATE S Y=DATE D DD^%DT S DATE=Y
  1. S MESSAGE(1)="The following payment has been processed to an Account in AR and"
  1. S MESSAGE(2)="needs to be moved from the station's suspense account 3875 to"
  1. S MESSAGE(3)="the appropriation/fund identified for this account online in FMS."
  1. S MESSAGE(4)=" "
  1. S MESSAGE(5)=" Receipt Number: "_$P(^RCY(344,RCRECTDA,0),"^")
  1. S MESSAGE(6)=" Payment Transaction Number: "_RCTRANDA
  1. S MESSAGE(7)=" Unapplied Deposit Number: "_$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)
  1. S MESSAGE(8)=" FMS CR document ID: "_$P($G(^RCY(344,RCRECTDA,2)),"^")
  1. S MESSAGE(9)=" Amount Paid: "_$J(+$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4),0,2)
  1. S MESSAGE(10)=" Process Date: "_DATE
  1. ; if package has been installed for 30 days, do not show hint
  1. ; look for first CR document processed for a receipt and the
  1. ; date the receipt was processed.
  1. S X=$P($G(^RCY(344,+$O(^RCY(344,"ADOC",$O(^RCY(344,"ADOC","")),0)),0)),"^",8)
  1. I X,$$FMDIFF^XLFDT(DT,X)<30 D
  1. . S MESSAGE(11)=" "
  1. . S MESSAGE(12)="HINT: (Make a note, this hint will soon disappear)"
  1. . S MESSAGE(13)="Once the payment has been moved from suspense in FMS, you can use"
  1. . S MESSAGE(14)="the Clear Suspense option under the Link Payment ListManager"
  1. . S MESSAGE(15)="screen to track the FMS document used to transfer the payment."
  1. . S MESSAGE(16)="Since the payment no longer appears on the Link Payment ListManager"
  1. . S MESSAGE(17)="screen, at the Select Payment option, press return with out selecting"
  1. . S MESSAGE(18)="a payment and you will have the option to enter the receipt and"
  1. . S MESSAGE(19)="transaction number (listed above)."
  1. S XMTEXT="MESSAGE("
  1. S XMSUB="Transfer Payment From Suspense Rec/# "_$P(^RCY(344,RCRECTDA,0),"^")_"/"_RCTRANDA
  1. S XMDUZ="AR Package",XMY("G.RCDP PAYMENTS")=""
  1. D ^XMD
  1. Q
  1. USERINIT(USER) ; get the initials of a user
  1. ;
  1. N UDATA
  1. ;
  1. ;if no User ID, quit with NULL
  1. Q:'USER ""
  1. ;
  1. ;get the user initials
  1. S UDATA=$G(^VA(200,USER,0))
  1. Q $P(UDATA,U,2)
  1. ;