source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCBDPSL1.m@ 1005

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

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1RCBDPSL1 ;WISC/RFJ-patient statement top list manager routine ;1 Dec 00
2 ;;4.5;Accounts Receivable;**162**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7INITCONT ; continue building list
8 ;
9 ; initialize line counter and transaction counter
10 S (RCLINE,RCTRCNT)=0
11 ; initialize patient account totals
12 S (RCTOTAL(1),RCTOTAL(2),RCTOTAL(3))=0
13 ;
14 ; show transactions by statement date
15 S RCSTATE=0 F S RCSTATE=$O(^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE)) Q:'RCSTATE D
16 . ; display statement date on listmanager screen
17 . S RCLINE=RCLINE+1
18 . S RCSTDATE=RCSTATE I RCSTDATE=10000000 S RCSTDATE="NEW ACTIVITY"
19 . I RCSTDATE S RCSTDATE=RCSTDATE_"00000" S RCSTDATE=$E(RCSTDATE,4,5)_"/"_$E(RCSTDATE,6,7)_"/"_$E(RCSTDATE,2,3)_" @ "_$E(RCSTDATE,9,10)_":"_$E(RCSTDATE,11,12)
20 . D SET("Transactions for LAST Patient Statement as of Date: "_RCSTDATE,RCLINE,1,80,0,IORVON,IORVOFF)
21 . ; initialize totals by statement date
22 . S (RCTOTAL(4),RCTOTAL(5),RCTOTAL(6))=0
23 . ; initialize flag marking transactions incomplete
24 . S RCFINCOM=0
25 . ;
26 . S RCDATE=0 F S RCDATE=$O(^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE)) Q:'RCDATE D
27 . . S RCTRANDA="" F S RCTRANDA=$O(^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)) Q:RCTRANDA="" D
28 . . . S RCVALUE=^TMP("RCBDPSLMDATA",$J,RCDEBTDA,RCSTATE,RCDATE,RCTRANDA)
29 . . . ;
30 . . . I 'RCTRANDA D SETBILL
31 . . . I RCTRANDA D SETTRAN
32 . . . ;
33 . . . ; compute totals by statement date
34 . . . S RCTOTAL(4)=RCTOTAL(4)+$P(RCVALUE,"^",2)
35 . . . S RCTOTAL(5)=RCTOTAL(5)+$P(RCVALUE,"^",3)
36 . . . S RCTOTAL(6)=RCTOTAL(6)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)+$P(RCVALUE,"^",6)
37 . . . ;
38 . . . ; compute totals by patient account
39 . . . S RCTOTAL(1)=RCTOTAL(1)+$P(RCVALUE,"^",2)
40 . . . S RCTOTAL(2)=RCTOTAL(2)+$P(RCVALUE,"^",3)
41 . . . S RCTOTAL(3)=RCTOTAL(3)+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)+$P(RCVALUE,"^",6)
42 . ;
43 . ; if transaction was set incomplete on any transactions, show why
44 . I RCFINCOM D
45 . . S RCLINE=RCLINE+1 D SET(" * indicates transaction",RCLINE,1,80)
46 . . S RCLINE=RCLINE+1 D SET(" * is MARKed INCOMPLETE",RCLINE,1,80)
47 . ;
48 . ; display totals by statement date
49 . S RCLINE=RCLINE+1
50 . D SET(" --------- -------- --------",RCLINE,1,80)
51 . S RCLINE=RCLINE+1
52 . D SET("TOTAL BY LAST STATEMENT AS OF DATE: "_RCSTDATE,RCLINE,1,80)
53 . D SET($J(RCTOTAL(4),9,2),RCLINE,53,62)
54 . D SET($J(RCTOTAL(5),9,2),RCLINE,62,71)
55 . D SET($J(RCTOTAL(6),9,2),RCLINE,71,80)
56 . ;
57 . ; if last statement date, check to see if it is equal to what is stored
58 . I RCSTATE=$P($P(RCEVENDA,"^"),".") D
59 . . S RCOUTBAL=0
60 . . I +RCTOTAL(4)'=+RCEVENT("PB") S RCOUTBAL=1
61 . . I +RCTOTAL(5)'=+RCEVENT("IN") S RCOUTBAL=1
62 . . I +RCTOTAL(6)'=(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF")) S RCOUTBAL=1
63 . . I RCOUTBAL D
64 . . . S RCLINE=RCLINE+1
65 . . . D SET(" ***** LAST PATIENT STATEMENT OUT OF BALANCE",RCLINE,1,80)
66 . . . D SET($J(RCEVENT("PB"),9,2),RCLINE,53,62)
67 . . . D SET($J(RCEVENT("IN"),9,2),RCLINE,62,71)
68 . . . D SET($J(RCEVENT("AD")+RCEVENT("CC")+RCEVENT("MF"),9,2),RCLINE,71,80)
69 . ;
70 . ;
71 . ; add some extra lines
72 . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
73 . S RCLINE=RCLINE+1 D SET(" ",RCLINE,1,80)
74 ;
75 ; show totals of all transactions displayed in listmanager
76 S RCLINE=RCLINE+1
77 D SET(" --------- -------- --------",RCLINE,1,80)
78 S RCLINE=RCLINE+1
79 D SET(" TOTAL BALANCE FOR PATIENT ACCOUNT",RCLINE,1,80)
80 D SET($J(RCTOTAL(1),9,2),RCLINE,53,62)
81 D SET($J(RCTOTAL(2),9,2),RCLINE,62,71)
82 D SET($J(RCTOTAL(3),9,2),RCLINE,71,80)
83 ;
84 ; set valmcnt to number of lines in the list
85 S VALMCNT=RCLINE
86 D HDR^RCDPAPLM
87 Q
88 ;
89 ;
90SETTRAN ; set a transaction on the listmanager line
91 N DATE,RCDPDATA
92 ;
93 ; get 433 data
94 D DIQ433^RCDPTPLM(RCTRANDA,".01;.03;12;19;")
95 ;
96 ; increment line number / transaction counter
97 S RCLINE=RCLINE+1,RCTRCNT=RCTRCNT+1
98 ;
99 ; bill number
100 D SET(RCTRCNT,RCLINE,1,80,0,IORVON,IORVOFF)
101 D SET($E($P(RCDPDATA(433,RCTRANDA,.03,"E"),"-",2)_" ",1,7),RCLINE,6,12)
102 ;
103 ; set transaction number
104 D SET(RCTRANDA,RCLINE,14,23)
105 ;
106 ; display transaction incomplete
107 I $P($G(^PRCA(433,RCTRANDA,0)),"^",10) D SET("*",RCLINE,24,24) S RCFINCOM=1
108 ;
109 ; set transaction date
110 S DATE=$P($G(RCDPDATA(433,RCTRANDA,19,"I")),".") I 'DATE S DATE=" "
111 I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
112 D SET(DATE,RCLINE,25,33)
113 ;
114 ; set transaction type
115 D SET($TR(RCDPDATA(433,RCTRANDA,12,"E"),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"),RCLINE,35,52)
116 D SET($J($P(RCVALUE,"^",2),9,2),RCLINE,53,62)
117 D SET($J($P(RCVALUE,"^",3),9,2),RCLINE,62,71)
118 ; add marshal fee and court cost to create admin dollars
119 D SET($J($P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)+$P(RCVALUE,"^",6),9,2),RCLINE,71,80)
120 Q
121 ;
122 ;
123SETBILL ; set a bill original amount
124 N DATE
125 ;
126 ; increment line number
127 S RCLINE=RCLINE+1
128 ;
129 ; bill number
130 D SET(" ",RCLINE,1,80)
131 D SET($E($P($P($G(^PRCA(430,+$P(RCVALUE,"^"),0)),"^"),"-",2)_" ",1,7),RCLINE,6,12)
132 ;
133 ; set bill date
134 S DATE=RCDATE I 'DATE S DATE=" "
135 I DATE S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
136 D SET(DATE,RCLINE,25,33)
137 ;
138 ; set transaction type
139 D SET("Original Amount",RCLINE,35,52)
140 D SET($J($P(RCVALUE,"^",2),9,2),RCLINE,53,62)
141 D SET($J(0,9,2),RCLINE,62,71)
142 ; add marshal fee and court cost to create admin dollars
143 D SET($J(0,9,2),RCLINE,71,80)
144 Q
145 ;
146 ;
147SET(STRING,LINE,COLBEG,COLEND,FIELD,ON,OFF) ; set array
148 I $G(FIELD) S STRING=STRING_$S(STRING="":"",1:": ")_$G(RCDPDATA(433,RCTRANDA,FIELD,"E"))
149 I STRING="",'$G(FIELD) D SET^VALM10(LINE,$J("",80)) Q
150 I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
151 D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLBEG,COLEND-COLBEG+1))
152 I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLBEG,$L(STRING),ON,OFF)
153 Q
Note: See TracBrowser for help on using the repository browser.