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