- 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 Mar 13, 2025@20:50:49 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
