RCDPLPSR ;WISC/RFJ-link payments suspense report ;1 Jun 99
;;4.5;Accounts Receivable;**114,148**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
REPORT ; report to show payments cleared from suspense in FMS
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^RCDPLPSR"
. 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
K ^TMP("RCDPLPSR",$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))
. . I '$P(RCDATA,"^",4) Q ;no payment amount
. . ; never sent to suspense
. . I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)="" Q
. . ; fms doc id not entered (field 26) to clear suspense
. . I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",6)="" 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 ^TMP("RCDPLPSR",$J,DATE,RCRECTDA,RCTRANDA)=$P(RECDATA,"^")_"^"_$$GETUNAPP^RCXFMSCR(RCRECTDA,RCTRANDA,0)_"^"_$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",6)_"^"_$P(RCDATA,"^",4)
;
; 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("RCDPLPSR",$J,DATE)) Q:'DATE!($G(RCRJFLAG)) D
. S RCRECTDA=0 F S RCRECTDA=$O(^TMP("RCDPLPSR",$J,DATE,RCRECTDA)) Q:'RCRECTDA!($G(RCRJFLAG)) D
. . S RCTRANDA=0 F S RCTRANDA=$O(^TMP("RCDPLPSR",$J,DATE,RCRECTDA,RCTRANDA)) Q:'RCTRANDA!($G(RCRJFLAG)) D
. . . S DATA=^TMP("RCDPLPSR",$J,DATE,RCRECTDA,RCTRANDA)
. . . W !,$P(DATA,"^"),?20,$J(RCTRANDA,5),?30,$P(DATA,"^",2),?50,$P(DATA,"^",3),?70,$J($P(DATA,"^",4),10,2)
. . . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
K ^TMP("RCDPLPSR",$J)
D ^%ZISC
Q
;
;
H ; header
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 !,"RECEIPT",?20,"TRAN#",?30,"UNAPPLIED DEPOSIT#",?50,"CLEAR FMS DOC ID#",?70,$J("AMOUNT",10)
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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPLPSR 5360 printed Sep 23, 2025@19:22:17 Page 2
RCDPLPSR ;WISC/RFJ-link payments suspense report ;1 Jun 99
+1 ;;4.5;Accounts Receivable;**114,148**;Mar 20, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
REPORT ; report to show payments cleared from suspense in FMS
+1 DO FULL^VALM1
+2 SET VALMBCK="R"
+3 ;
+4 WRITE !!,"This option will print a report showing all unlinked payments"
+5 WRITE !,"received between selected dates that were processed to the station's"
+6 WRITE !,"suspense account and later cleared by on-line FMS input.",!
+7 ;
+8 NEW DATEEND,DATESTRT
+9 DO DATESEL^RCRJRTRA("PAYMENT")
+10 IF '$GET(DATESTRT)!('$GET(DATEEND))
QUIT
+11 ;
+12 ; select device
+13 WRITE !
SET %ZIS="Q"
DO ^%ZIS
IF POP
SET VALMBCK="R"
QUIT
+14 IF $DATA(IO("Q"))
Begin DoDot:1
+15 SET ZTDESC="AR Clear Suspense Payment Report"
SET ZTRTN="DQ^RCDPLPSR"
+16 SET ZTSAVE("DATE*")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO ^%ZISC
SET VALMBCK="R"
QUIT
+17 WRITE !!,"<*> please wait <*>"
+18 DO DQ
+19 READ !,"Press RETURN to continue:",%:DTIME
+20 SET VALMBCK="R"
+21 QUIT
+22 ;
+23 ;
DQ ; report (queue) starts here
+1 NEW DATA,DATE,DATEDIS1,DATEDIS2,NOW,PAGE,RCDATA,RCRECTDA,RCRJFLAG,RCRJLINE,RCTRANDA,RECDATA,SCREEN
+2 KILL ^TMP("RCDPLPSR",$JOB)
+3 SET RCRECTDA=0
FOR
SET RCRECTDA=$ORDER(^RCY(344,RCRECTDA))
if 'RCRECTDA
QUIT
Begin DoDot:1
+4 SET RECDATA=$GET(^RCY(344,RCRECTDA,0))
+5 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^RCY(344,RCRECTDA,1,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+6 SET RCDATA=$GET(^RCY(344,RCRECTDA,1,RCTRANDA,0))
+7 ;no payment amount
IF '$PIECE(RCDATA,"^",4)
QUIT
+8 ; never sent to suspense
+9 IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)=""
QUIT
+10 ; fms doc id not entered (field 26) to clear suspense
+11 IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",6)=""
QUIT
+12 ; get payment date
+13 SET DATE=$PIECE(RCDATA,"^",6)
+14 IF 'DATE
SET DATE=$PIECE(RCDATA,"^",10)
+15 IF 'DATE
SET DATE=$PIECE(RECDATA,"^",3)
+16 IF 'DATE
SET DATE=0
+17 SET DATE=$PIECE(DATE,".")
+18 IF DATE<DATESTRT!(DATE>DATEEND)
QUIT
+19 SET ^TMP("RCDPLPSR",$JOB,DATE,RCRECTDA,RCTRANDA)=$PIECE(RECDATA,"^")_"^"_$$GETUNAPP^RCXFMSCR(RCRECTDA,RCTRANDA,0)_"^"_$PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",6)_"^"_$PIECE(RCDATA,"^",4)
End DoDot:2
End DoDot:1
+20 ;
+21 ; print report
+22 SET Y=$PIECE(DATESTRT,".")
DO DD^%DT
SET DATEDIS1=Y
+23 SET Y=$PIECE(DATEEND,".")
DO DD^%DT
SET DATEDIS2=Y
+24 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
+25 SET PAGE=1
SET RCRJLINE=""
SET $PIECE(RCRJLINE,"-",81)=""
+26 SET SCREEN=0
IF '$DATA(ZTQUEUED)
IF IO=IO(0)
IF $EXTRACT(IOST)="C"
SET SCREEN=1
+27 USE IO
DO H
+28 SET DATE=0
FOR
SET DATE=$ORDER(^TMP("RCDPLPSR",$JOB,DATE))
if 'DATE!($GET(RCRJFLAG))
QUIT
Begin DoDot:1
+29 SET RCRECTDA=0
FOR
SET RCRECTDA=$ORDER(^TMP("RCDPLPSR",$JOB,DATE,RCRECTDA))
if 'RCRECTDA!($GET(RCRJFLAG))
QUIT
Begin DoDot:2
+30 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^TMP("RCDPLPSR",$JOB,DATE,RCRECTDA,RCTRANDA))
if 'RCTRANDA!($GET(RCRJFLAG))
QUIT
Begin DoDot:3
+31 SET DATA=^TMP("RCDPLPSR",$JOB,DATE,RCRECTDA,RCTRANDA)
+32 WRITE !,$PIECE(DATA,"^"),?20,$JUSTIFY(RCTRANDA,5),?30,$PIECE(DATA,"^",2),?50,$PIECE(DATA,"^",3),?70,$JUSTIFY($PIECE(DATA,"^",4),10,2)
+33 IF $Y>(IOSL-6)
if SCREEN
DO PAUSE^RCRJRTR1
if $GET(RCRJFLAG)
QUIT
DO H
End DoDot:3
End DoDot:2
End DoDot:1
+34 KILL ^TMP("RCDPLPSR",$JOB)
+35 DO ^%ZISC
+36 QUIT
+37 ;
+38 ;
H ; header
+1 SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+2 WRITE $CHAR(13),"AR CLEARED SUSPENSE REPORT",?(80-$LENGTH(%)),%
+3 WRITE !," FOR THE DATE RANGE: ",DATEDIS1," TO ",DATEDIS2
+4 WRITE !,"RECEIPT",?20,"TRAN#",?30,"UNAPPLIED DEPOSIT#",?50,"CLEAR FMS DOC ID#",?70,$JUSTIFY("AMOUNT",10)
+5 WRITE !,RCRJLINE
+6 QUIT
+7 ;
+8 ;
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
+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
