source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPLPSR.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.1 KB
Line 
1RCDPLPSR ;WISC/RFJ-link payments suspense report ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,148**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7REPORT ; report to show payments cleared from suspense in FMS
8 D FULL^VALM1
9 S VALMBCK="R"
10 ;
11 W !!,"This option will print a report showing all unlinked payments"
12 W !,"received between selected dates that were processed to the station's"
13 W !,"suspense account and later cleared by on-line FMS input.",!
14 ;
15 N DATEEND,DATESTRT
16 D DATESEL^RCRJRTRA("PAYMENT")
17 I '$G(DATESTRT)!('$G(DATEEND)) Q
18 ;
19 ; select device
20 W ! S %ZIS="Q" D ^%ZIS I POP S VALMBCK="R" Q
21 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D ^%ZISC S VALMBCK="R" Q
22 . S ZTDESC="AR Clear Suspense Payment Report",ZTRTN="DQ^RCDPLPSR"
23 . S ZTSAVE("DATE*")="",ZTSAVE("ZTREQ")="@"
24 W !!,"<*> please wait <*>"
25 D DQ
26 R !,"Press RETURN to continue:",%:DTIME
27 S VALMBCK="R"
28 Q
29 ;
30 ;
31DQ ; report (queue) starts here
32 N DATA,DATE,DATEDIS1,DATEDIS2,NOW,PAGE,RCDATA,RCRECTDA,RCRJFLAG,RCRJLINE,RCTRANDA,RECDATA,SCREEN
33 K ^TMP("RCDPLPSR",$J)
34 S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,RCRECTDA)) Q:'RCRECTDA D
35 . S RECDATA=$G(^RCY(344,RCRECTDA,0))
36 . S RCTRANDA=0 F S RCTRANDA=$O(^RCY(344,RCRECTDA,1,RCTRANDA)) Q:'RCTRANDA D
37 . . S RCDATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
38 . . I '$P(RCDATA,"^",4) Q ;no payment amount
39 . . ; never sent to suspense
40 . . I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)="" Q
41 . . ; fms doc id not entered (field 26) to clear suspense
42 . . I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",6)="" Q
43 . . ; get payment date
44 . . S DATE=$P(RCDATA,"^",6)
45 . . I 'DATE S DATE=$P(RCDATA,"^",10)
46 . . I 'DATE S DATE=$P(RECDATA,"^",3)
47 . . I 'DATE S DATE=0
48 . . S DATE=$P(DATE,".")
49 . . I DATE<DATESTRT!(DATE>DATEEND) Q
50 . . 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)
51 ;
52 ; print report
53 S Y=$P(DATESTRT,".") D DD^%DT S DATEDIS1=Y
54 S Y=$P(DATEEND,".") D DD^%DT S DATEDIS2=Y
55 D NOW^%DTC S Y=% D DD^%DT S NOW=Y
56 S PAGE=1,RCRJLINE="",$P(RCRJLINE,"-",81)=""
57 S SCREEN=0 I '$D(ZTQUEUED),IO=IO(0),$E(IOST)="C" S SCREEN=1
58 U IO D H
59 S DATE=0 F S DATE=$O(^TMP("RCDPLPSR",$J,DATE)) Q:'DATE!($G(RCRJFLAG)) D
60 . S RCRECTDA=0 F S RCRECTDA=$O(^TMP("RCDPLPSR",$J,DATE,RCRECTDA)) Q:'RCRECTDA!($G(RCRJFLAG)) D
61 . . S RCTRANDA=0 F S RCTRANDA=$O(^TMP("RCDPLPSR",$J,DATE,RCRECTDA,RCTRANDA)) Q:'RCTRANDA!($G(RCRJFLAG)) D
62 . . . S DATA=^TMP("RCDPLPSR",$J,DATE,RCRECTDA,RCTRANDA)
63 . . . W !,$P(DATA,"^"),?20,$J(RCTRANDA,5),?30,$P(DATA,"^",2),?50,$P(DATA,"^",3),?70,$J($P(DATA,"^",4),10,2)
64 . . . I $Y>(IOSL-6) D:SCREEN PAUSE^RCRJRTR1 Q:$G(RCRJFLAG) D H
65 K ^TMP("RCDPLPSR",$J)
66 D ^%ZISC
67 Q
68 ;
69 ;
70H ; header
71 S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
72 W $C(13),"AR CLEARED SUSPENSE REPORT",?(80-$L(%)),%
73 W !," FOR THE DATE RANGE: ",DATEDIS1," TO ",DATEDIS2
74 W !,"RECEIPT",?20,"TRAN#",?30,"UNAPPLIED DEPOSIT#",?50,"CLEAR FMS DOC ID#",?70,$J("AMOUNT",10)
75 W !,RCRJLINE
76 Q
77 ;
78 ;
79MAILMSG(RCRECTDA,RCTRANDA) ; generate message to users showing what needs to be moved out
80 ; of suspense to 5287
81 N %Z,DATE,DDH,MESSAGE,X9,XCNP,XMDUZ,XMZ,X,Y
82 S DATE=$P($P($G(^RCY(344,RCRECTDA,0)),"^",8),".") I DATE S Y=DATE D DD^%DT S DATE=Y
83 S MESSAGE(1)="The following payment has been processed to an Account in AR and"
84 S MESSAGE(2)="needs to be moved from the station's suspense account 3875 to"
85 S MESSAGE(3)="the appropriation/fund identified for this account online in FMS."
86 S MESSAGE(4)=" "
87 S MESSAGE(5)=" Receipt Number: "_$P(^RCY(344,RCRECTDA,0),"^")
88 S MESSAGE(6)=" Payment Transaction Number: "_RCTRANDA
89 S MESSAGE(7)=" Unapplied Deposit Number: "_$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",5)
90 S MESSAGE(8)=" FMS CR document ID: "_$P($G(^RCY(344,RCRECTDA,2)),"^")
91 S MESSAGE(9)=" Amount Paid: "_$J(+$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,0)),"^",4),0,2)
92 S MESSAGE(10)=" Process Date: "_DATE
93 ; if package has been installed for 30 days, do not show hint
94 ; look for first CR document processed for a receipt and the
95 ; date the receipt was processed.
96 S X=$P($G(^RCY(344,+$O(^RCY(344,"ADOC",$O(^RCY(344,"ADOC","")),0)),0)),"^",8)
97 I X,$$FMDIFF^XLFDT(DT,X)<30 D
98 . S MESSAGE(11)=" "
99 . S MESSAGE(12)="HINT: (Make a note, this hint will soon disappear)"
100 . S MESSAGE(13)="Once the payment has been moved from suspense in FMS, you can use"
101 . S MESSAGE(14)="the Clear Suspense option under the Link Payment ListManager"
102 . S MESSAGE(15)="screen to track the FMS document used to transfer the payment."
103 . S MESSAGE(16)="Since the payment no longer appears on the Link Payment ListManager"
104 . S MESSAGE(17)="screen, at the Select Payment option, press return with out selecting"
105 . S MESSAGE(18)="a payment and you will have the option to enter the receipt and"
106 . S MESSAGE(19)="transaction number (listed above)."
107 S XMTEXT="MESSAGE("
108 S XMSUB="Transfer Payment From Suspense Rec/# "_$P(^RCY(344,RCRECTDA,0),"^")_"/"_RCTRANDA
109 S XMDUZ="AR Package",XMY("G.RCDP PAYMENTS")=""
110 D ^XMD
111 Q
Note: See TracBrowser for help on using the repository browser.