| 1 | RCRJRCOR ;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 | ; | 
|---|
| 7 | SEND ;  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 | ; | 
|---|
| 145 | NDB(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 | ; | 
|---|
| 170 | SUMMARY ;  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 | ; | 
|---|
| 198 | SET(DATA)          ;  store report | 
|---|
| 199 | S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA | 
|---|
| 200 | Q | 
|---|
| 201 | ; | 
|---|
| 202 | ; | 
|---|
| 203 | SENDMSG(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) | 
|---|