source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCDPLPLM.m@ 1680

Last change on this file since 1680 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1RCDPLPLM ;WISC/RFJ-link payments listmanager top routine ;1 Jun 99
2 ;;4.5;Accounts Receivable;**114,208**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 N RCFCHECK,RCFTRACE,RCFCREDT,RCDPFXIT
6 N %,%DT,%H,%I,RCDPPADT,X,Y
7 S %DT("A")="Start with Payment Date (press RETURN for FIRST): ",%DT="AEP",%DT(0)=-DT
8 D ^%DT I Y<0,X["^" Q
9 ; if user entered a date, go back one day
10 I Y'<0 S RCDPPADT=$$FMADD^XLFDT(+Y,-1)
11 ;
12 D EN^VALM("RCDP LINK PAYMENTS TO ACCOUNTS")
13 Q
14 ;
15INIT ; initialization for list manager list
16 ; pass RCDPPADT to display payments after RCDPPADT date
17 ; pass RCFCHECK, RCFTRACE and RCFCREDT to search by
18 ; check/trace #/credit card #
19 ; fast exit
20 I $G(RCDPFXIT) S VALMQUIT=1 Q
21 ;
22 W !!,"please wait, building list of unlinked payments..."
23 ;
24 N DATE,FMSDOC,NUMBER,RCCOUNT,RCDATA,RCLINE,RCRECTDA,RCTOTAL,RCTRANDA,RECDATA,TYPE
25 ;
26 ; set the listmanager line number
27 S RCLINE=0
28 ; set the lookup payment number from list
29 S RCCOUNT=0
30 ; get list of unlinked accounts
31 K ^TMP("RCDPLPLM",$J)
32 S RCRECTDA=0 F S RCRECTDA=$O(^RCY(344,"AN",RCRECTDA)) Q:'RCRECTDA D
33 . S RECDATA=$G(^RCY(344,RCRECTDA,0))
34 . S RCTRANDA=0 F S RCTRANDA=$O(^RCY(344,"AN",RCRECTDA,RCTRANDA)) Q:'RCTRANDA D
35 . . S RCDATA=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
36 . . I '$P(RCDATA,"^",4) Q ;no payment amount
37 . . ; fms doc id entered (field 26) to clear suspense
38 . . I $P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",6)'="" Q
39 . . ; unlinked
40 . . ; get payment date
41 . . S DATE=$P(RCDATA,"^",6)
42 . . I 'DATE S DATE=$P(RCDATA,"^",10)
43 . . I 'DATE S DATE=$P(RECDATA,"^",3)
44 . . I 'DATE S DATE=0
45 . . ; before selected payment date
46 . . I $G(RCDPPADT),DATE<RCDPPADT Q
47 . . ;
48 . . S RCLINE=RCLINE+1
49 . . S RCCOUNT=RCCOUNT+1
50 . . ;
51 . . ; create an index array for bill lookup in list
52 . . S ^TMP("RCDPLPLM",$J,"IDX",RCCOUNT,RCCOUNT)=RCRECTDA_"^"_RCTRANDA
53 . . ;
54 . . D SET(RCCOUNT,RCLINE,1,80)
55 . . ; receipt number
56 . . D SET($P(RECDATA,"^"),RCLINE,6,18)
57 . . ; transaction number
58 . . D SET($J(RCTRANDA,5),RCLINE,18,24)
59 . . ; unapplied deposit number
60 . . D SET($J($$GETUNAPP^RCXFMSCR(RCRECTDA,RCTRANDA,0),13),RCLINE,26,39)
61 . . ; receipt status
62 . . D SET($E($S($P(RECDATA,"^",14):"OPEN",1:"CLOSED"),1,4),RCLINE,41,44)
63 . . ; payment date
64 . . D SET($E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),RCLINE,47,54)
65 . . ; get type of payment
66 . . S TYPE=$S($P(RECDATA,U,18)&$P(RECDATA,U,17):"TRACE",1:"") ;EFT/ERA payment
67 . . I TYPE="" D
68 . . . S TYPE=$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^",4)
69 . . . S TYPE=$S(TYPE=1:"CASH",TYPE=2:"CHECK",TYPE=3:"CREDIT",1:"")
70 . . I TYPE="" S TYPE=$P($G(^RC(341.1,+$P(RECDATA,"^",4),0)),"^")
71 . . D SET(TYPE,RCLINE,57,60)
72 . . ; get check, trace, credit #, RCFCHECK RCFTRACE and RCFCREDT
73 . . ; can be used to match a specific check, trace or credit card #
74 . . ; the variable is in the form:
75 . . ; RCFCHECK=number^EXACT or number^CONTAINS
76 . . I $G(RCFCHECK)'="",$E(TYPE,1,5)'="CHECK" Q
77 . . I $G(RCFTRACE)'="",$E(TYPE,1,5)'="TRACE" Q
78 . . I $G(RCFCREDT)'="",$E(TYPE,1,6)'="CREDIT" Q
79 . . S NUMBER=""
80 . . I $E(TYPE,1,5)="CHECK" D Q:NUMBER=""
81 . . . S NUMBER=$P(RCDATA,"^",7)
82 . . . I $G(RCFCHECK)'="",NUMBER="" Q
83 . . . I $E($P($G(RCFCHECK),"^",2))="E",NUMBER'=$P(RCFCHECK,"^") S NUMBER="" Q
84 . . . I $E($P($G(RCFCHECK),"^",2))="C",NUMBER'[$P(RCFCHECK,"^") S NUMBER="" Q
85 . . . I NUMBER="" S NUMBER=" "
86 . . I $E(TYPE,1,5)="TRACE" D Q:NUMBER=""
87 . . . S NUMBER=$P($G(^RCY(344.4,+$P(RECDATA,U,18),0)),U,2)
88 . . . I $G(RCFTRACE)'="",NUMBER="" Q
89 . . . I $E($P($G(RCFTRACE),"^",2))="E",NUMBER'=$P(RCFTRACE,"^") S NUMBER="" Q
90 . . . I $E($P($G(RCFTRACE),"^",2))="C",NUMBER'[$P(RCFTRACE,"^") S NUMBER="" Q
91 . . . I NUMBER="" S NUMBER=" "
92 . . I $E(TYPE,1,6)="CREDIT" D Q:NUMBER=""
93 . . . S NUMBER=$P(RCDATA,"^",11)
94 . . . I $G(RCFCHECK)'="",NUMBER="" Q
95 . . . I $E($P($G(RCFCREDT),"^",2))="E",NUMBER'=$P(RCFCREDT,"^") S NUMBER="" Q
96 . . . I $E($P($G(RCFCREDT),"^",2))="C",NUMBER'[$P(RCFCREDT,"^") S NUMBER="" Q
97 . . . I NUMBER="" S NUMBER=" "
98 . . I NUMBER="" S NUMBER=" "
99 . . S %=$L(NUMBER) I %>8 S NUMBER=$E(NUMBER,%-7,%)
100 . . ; check/trace/credit# (last 8 chars)
101 . . D SET(NUMBER,RCLINE,62,69)
102 . . ; amount paid
103 . . D SET($J($P(RCDATA,"^",4),10,2),RCLINE,70,80)
104 . . ; since list manager adds spaces to line, make sure line is
105 . . ; 80 characters so the print list looks okay
106 . . S ^TMP("RCDPLPLM",$J,RCLINE,0)=$E(^TMP("RCDPLPLM",$J,RCLINE,0),1,80)
107 . . S RCTOTAL=$G(RCTOTAL)+$P(RCDATA,"^",4)
108 . . ;
109 . . ; show line 2
110 . . ; account lookup
111 . . S RCLINE=RCLINE+1
112 . . S %=$E("AcctLU: "_$P($G(^RCY(344,RCRECTDA,1,RCTRANDA,2)),"^")_" ",1,24)
113 . . D SET(" "_%,RCLINE,1,80)
114 . . ; fms cr document
115 . . S FMSDOC=$$FMSSTAT^RCDPUREC(RCRECTDA)
116 . . D SET($E("CRdoc: "_$P(FMSDOC,"^")_" ",1,22),RCLINE,41,80)
117 . . ; cr document status
118 . . D SET($P(FMSDOC,"^",2),RCLINE,63,68)
119 . . ; make second line longer than 80 characters for printing
120 . . ; this will add an extra line after each entry
121 . . D SET(" ",RCLINE,80,84)
122 ;
123 S RCLINE=RCLINE+1 D SET("----------",RCLINE,70,80)
124 S RCLINE=RCLINE+1 D SET("TOTAL: "_$J($G(RCTOTAL),10,2),RCLINE,63,80)
125 ;
126 ; set valmcnt to number of lines in the list
127 S VALMCNT=RCLINE
128 D HDR
129 Q
130 ;
131 ;
132SET(STRING,LINE,COLBEG,COLEND) ; set array
133 I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
134 D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
135 Q
136 ;
137 ;
138HDR ; header code for list manager display
139 S VALMHDR(1)="Transactions for ALL Unapplied Payments"
140 I $G(RCDPPADT)>0 S Y=RCDPPADT D DD^%DT S VALMHDR(1)="Transactions for Unapplied Payments After "_Y
141 S VALMHDR(2)=" "
142 I $G(RCFCHECK)'="" S VALMHDR(2)=" List of Payments With Check Numbers "_$P(RCFCHECK,"^",2)_" "_$P(RCFCHECK,"^")
143 I $G(RCFTRACE)'="" S VALMHDR(2)=" List of Payments With Trace Numbers "_$P(RCFTRACE,"^",2)_" "_$P(RCFTRACE,"^")
144 I $G(RCFCREDT)'="" S VALMHDR(2)=" List of Payments With Credit Cards "_$P(RCFCREDT,"^",2)_" "_$P(RCFCREDT,"^")
145 Q
146 ;
147 ;
148EXIT ; exit list manager option and clean up
149 K ^TMP("RCDPLPLM",$J),^TMP("RCDPLPLMUNLINK",$J)
150 Q
Note: See TracBrowser for help on using the repository browser.