source: WorldVistAEHR/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCRJRCOR.m@ 703

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

initial load of WorldVistAEHR
File size: 9.1 KB
Line 
1RCRJRCOR ;WISC/RFJ-ar data collector summary report ;1 Mar 97
2 ;;4.5;Accounts Receivable;**68,96,139,103,156,170,174,191,220,138,239**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7SEND ; send data to ndb and data to FMS
8 N %,AMOUNT,DATEMOYR,FUND,LINE,RSC,SPACE,TOTAL,TOTALFUN,TOTALTYP,TYPE,X,XMY,Y
9 ;
10 ; ---------- send to ndb ----------
11 ; data stored in tmp($j,rcrjrcolndb)
12 I '$G(RCRJFAR1) D NDB(PRCASITE,DATEBEG,DATEEND)
13 ;
14 ;
15 ; ---------- send sv to fms ----------
16 ; data stored in tmp($j,rcrjrcolsv)
17 ; rcrjfsv is a flag set in the routine rcrjrco for retransmission
18 ; to prevent accepted fms documents from being resent
19 I '$G(RCRJFSV) D STARTSV^RCXFMSSV(DATEEND)
20 ;
21 ;
22 ; ---------- send wr to fms ----------
23 ; data stored in tmp($j,rcrjrcolwr)
24 ; rcrjfwr is a flag set in the routine rcrjrco for retransmission
25 ; to prevent accepted fms documents from being resent
26 I '$G(RCRJFWR) D STARTWR^RCXFMSWR(DATEEND)
27 ;
28 ; ---------- send tr to fms ----------
29 N RCTRANS
30 ; this call returns rctrans array (see rcxfmstx for description)
31 ; rcrjftr is a flag set in the routine rcrjrco for retransmission
32 ; to prevent accepted fms documents from being resent
33 I '$G(RCRJFTR) D STARTTR^RCXFMSTX(DATEEND)
34 ;
35 ; ---------- send oig extract ----------
36 ; data stored in tmp(j,rcrjroig)
37 ; get non-mccf bills for extract and user report
38 D NONMCCF^RCRJROIG(DATEEND)
39 ; rcrjfoig is a flag set in the routine rcrjrco for retransmission
40 ; to prevent the oig extract from being resent
41 I '$G(RCRJFOIG) D OIG^RCRJROIG(DATEEND)
42 ;
43 ; generate a mailman message to the group showing the data
44 K ^TMP($J,"RCRJRCORMM")
45 S Y=$E(DATEEND,1,5)_"00" D DD^%DT S DATEMOYR=Y
46 S LINE=0,SPACE="",$P(SPACE," ",80)=""
47 D SET("Data has been collected for the month "_DATEMOYR_". The data has been")
48 D SET("transmitted to the following systems:")
49 D SET(" ")
50 ;
51 I '$G(RCRJFAR1) D
52 . D SET("NATIONAL DATABASE DATA")
53 . D SET("----------------------")
54 . D SET("The data has been sent to the National Database. For a detail list")
55 . D SET("of the data sent, please review the Return Reports which are sent")
56 . D SET("from the National Database.")
57 . D SET(" ")
58 ;
59 I '$G(RCRJFSV) D
60 . D SET("FMS, STANDARD VOUCHER (SV) DOCUMENT")
61 . D SET("-----------------------------------")
62 . D SET("The following data has been transmitted to FMS in the SV document:")
63 . D SET(" Revenue Source Code Type Amount")
64 . D SET(" ------------------- ---- ------")
65 . S TOTAL=0
66 . S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLSV",TYPE)) Q:TYPE="" D
67 . . I TYPE=17!(TYPE=18) Q ; display the Medicare totals later
68 . . S TOTALTYP=0
69 . . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND)) Q:FUND="" D
70 . . . S TOTALFUN=0
71 . . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC)) Q:RSC="" S AMOUNT=^(RSC) D
72 . . . . D SET(" "_RSC_" "_$E($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$J(AMOUNT,13,2))
73 . . . . S TOTALFUN=TOTALFUN+AMOUNT
74 . . . . S TOTALTYP=TOTALTYP+AMOUNT
75 . . . . S TOTAL=TOTAL+AMOUNT
76 . . . ;
77 . . . N RCFUND S RCFUND=$S($E(DATEEND,2,5)<"0410":$E(FUND,1,4)_"."_$E(FUND,6),1:$E(FUND,1,4)_"0"_$E(FUND,6))
78 . . . I TYPE=21 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
79 . . ;
80 . . D SET(" ----------")
81 . . D SET(" TOTAL TYPE "_TYPE_$J(TOTALTYP,13,2))
82 . . D SET(" ")
83 . ;
84 . ; Display Medicare totals and update the SV total
85 . S AMOUNT=+$G(^TMP($J,"RCRJRCOLSV",17)),TOTAL=TOTAL+AMOUNT
86 . D SET(" Medicare Contractual Adjustment TOTAL TYPE 17"_$J(AMOUNT,13,2))
87 . S AMOUNT=+$G(^TMP($J,"RCRJRCOLSV",18)),TOTAL=TOTAL+AMOUNT
88 . D SET(" Unreimbursable Medicare Expense TOTAL TYPE 18"_$J(AMOUNT,13,2))
89 . D SET(" ")
90 . ;
91 . D SET(" ----------")
92 . D SET(" TOTAL SV"_$J(TOTAL,13,2))
93 . D SET(" ")
94 ;
95 I '$G(RCRJFWR) D
96 . D SET("FMS, WRITEOFFS/CONTRACT ADJUSTMENTS (WR) DOCUMENT")
97 . D SET("-------------------------------------------------")
98 . D SET("The following data has been transmitted to FMS in the WR document:")
99 . D SET(" Revenue Source Code Type Amount")
100 . D SET(" ------------------- ---- ------")
101 . S TOTAL=0
102 . S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLWR",TYPE)) Q:TYPE="" D
103 . . S TOTALTYP=0
104 . . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND)) Q:FUND="" D
105 . . . S TOTALFUN=0
106 . . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC)) Q:RSC="" S AMOUNT=^(RSC) D
107 . . . . D SET(" "_RSC_" "_$E($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$J(AMOUNT,13,2))
108 . . . . S TOTALFUN=TOTALFUN+AMOUNT
109 . . . . S TOTALTYP=TOTALTYP+AMOUNT
110 . . . . S TOTAL=TOTAL+AMOUNT
111 . . . ;
112 . . . N RCFUND S RCFUND=$S($E(DATEEND,2,5)<"0410":$E(FUND,1,4)_"."_$E(FUND,6),1:$E(FUND,1,4)_"0"_$E(FUND,6))
113 . . . I TYPE=37 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
114 . . ;
115 . . D SET(" ----------")
116 . . D SET(" TOTAL TYPE "_TYPE_$J(TOTALTYP,13,2))
117 . . D SET(" ")
118 . D SET(" ----------")
119 . D SET(" TOTAL WR"_$J(TOTAL,13,2))
120 . D SET(" ")
121 ;
122 I '$G(RCRJFTR) D
123 . D SET("FMS, TRANSFER FROM MCCF TO HSIF (TR) DOCUMENT")
124 . D SET("-------------------------------------------------")
125 . D SET("The following data has been transmitted to FMS in the TR document:")
126 . D SET(" From Fund From RSC To Fund To RSC Amount")
127 . D SET(" --------- -------- ------- ------ ----------")
128 . I $O(RCTRANS(""))="" D SET(" No Dollars to Transfer.") Q
129 . ;
130 . S FUND="" F S FUND=$O(RCTRANS(FUND)) Q:FUND="" D
131 . . S RSC="" F S RSC=$O(RCTRANS(FUND,RSC)) Q:RSC="" D
132 . . . ; rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount
133 . . . S AMOUNT=RCTRANS(FUND,RSC)
134 . . . D SET($J(FUND,11)_$J(RSC,12)_$J($P(AMOUNT,"^"),14)_$J($P(AMOUNT,"^",2),10)_$J($P(AMOUNT,"^",3),31,2))
135 ;
136 S XMY("G.RC AR DATA COLLECTOR")=""
137 S %=$$SENDMSG("AR Data Collector for "_DATEMOYR_" Station "_PRCASITE,.XMY)
138 K ^TMP($J,"RCRJRCORMM")
139 ;
140 ; send users detail report
141 D USERREPT^RCRJRCOU(DATEMOYR)
142 Q
143 ;
144 ;
145NDB(PRCASITE,DATEBEG,DATEEND) ; send data to the national database
146 N %,BATCNAME,COUNT,CRITERIA,DATA,LINE,XMY,X,Y
147 K ^TMP($J,"RCRJRCORMM")
148 S LINE=2,DATA="D$ "
149 S CRITERIA="" F COUNT=1:1 S CRITERIA=$O(^TMP($J,"RCRJRCOLNDB",CRITERIA)) Q:CRITERIA="" D
150 . S DATA=DATA_":"_COUNT_"/"_CRITERIA_"/"_^TMP($J,"RCRJRCOLNDB",CRITERIA)
151 . I $L(DATA)>200 D SET(DATA) S DATA="D$ "
152 I DATA'="D$ " D SET(DATA)
153 ;
154 ; build the first two control lines in mail message
155 S Y=DATEBEG D DD^%DT
156 S BATCNAME="AR1-"_$E(Y,1,3)_$E(DATEBEG,6,7)_$TR($P(Y,",",2)," ")
157 S Y=DATEEND D DD^%DT
158 S BATCNAME=BATCNAME_"-"_$E(Y,1,3)_$E(DATEEND,6,7)_$TR($P(Y,",",2)," ")
159 S ^TMP($J,"RCRJRCORMM",1)="T$ "_PRCASITE_"$"_BATCNAME_"$$$$$*"
160 ; get end time (in %)
161 D NOW^%DTC
162 S ^TMP($J,"RCRJRCORMM",2)="S$ "_STRTTIME_"^"_%_"$0$"_(COUNT-1)
163 ;
164 S XMY("S.PRQN DATA COLLECTION MONITOR@FO-ALBANY.MED.VA.GOV")=""
165 S %=$$SENDMSG("AR1 "_$E(DATEEND,4,5)_"/"_$E(DATEEND,2,3)_" NDB DATA FOR SITE "_PRCASITE,.XMY)
166 K ^TMP($J,"RCRJRCORMM")
167 Q
168 ;
169 ;
170SUMMARY ; print summary report in mailman bulletin
171 N %,BILLDA,CRITER2,CRITERIA,DATA0,DFN,LINE,STAT,TOTAL,VA,XMY
172 K ^TMP($J,"RCRJRCOR") ; used to identify test patients
173 K ^TMP($J,"RCRJRCORMM") ; used to build mailman message
174 ;
175 ; print any test patient bills which have not been closed
176 S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJRCOL","CRIT2",1,BILLDA)) Q:'BILLDA I $D(^(BILLDA,1)) D
177 . S DATA0=$G(^PRCA(430,BILLDA,0)),STAT=$P(DATA0,"^",8)
178 . I STAT'=16,STAT='42 Q ; bill not currently open
179 . S DFN=+$P(DATA0,"^",7) I 'DFN Q
180 . D PID^VADPT
181 . I $E($TR($G(VA("PID")),"-"),1,5)="00000" S ^TMP($J,"RCRJRCOR","TEST",BILLDA)=""
182 ;
183 I '$D(^TMP($J,"RCRJRCOR","TEST")) Q
184 ;
185 ; print data
186 S LINE=0
187 D SET(" ")
188 D SET("The following bills are active and linked to test patients:")
189 S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJRCOR","TEST",BILLDA)) Q:'BILLDA D SET(" "_$P($G(^PRCA(430,BILLDA,0)),"^")_" (#",BILLDA_")")
190 ;
191 S XMY("G.RC AR DATA COLLECTOR")=""
192 S %=$$SENDMSG("MCCR DATA COLLECTOR INFORMATION",.XMY)
193 K ^TMP($J,"RCRJRCOR")
194 K ^TMP($J,"RCRJRCORMM")
195 Q
196 ;
197 ;
198SET(DATA) ; store report
199 S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
200 Q
201 ;
202 ;
203SENDMSG(XMSUB,XMY) ; send message with subject and recipients
204 N %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
205 S XMDUZ="AR PACKAGE",XMTEXT="^TMP($J,""RCRJRCORMM"","
206 D ^XMD
207 Q +$G(XMZ)
Note: See TracBrowser for help on using the repository browser.