208 lines
9.1 KiB
Mathematica
208 lines
9.1 KiB
Mathematica
RCRJRCOR ;WISC/RFJ-ar data collector summary report ;1 Mar 97
|
|
;;4.5;Accounts Receivable;**68,96,139,103,156,170,174,191,220,138,239**;Mar 20, 1995
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
SEND ; send data to ndb and data to FMS
|
|
N %,AMOUNT,DATEMOYR,FUND,LINE,RSC,SPACE,TOTAL,TOTALFUN,TOTALTYP,TYPE,X,XMY,Y
|
|
;
|
|
; ---------- send to ndb ----------
|
|
; data stored in tmp($j,rcrjrcolndb)
|
|
I '$G(RCRJFAR1) D NDB(PRCASITE,DATEBEG,DATEEND)
|
|
;
|
|
;
|
|
; ---------- send sv to fms ----------
|
|
; data stored in tmp($j,rcrjrcolsv)
|
|
; rcrjfsv is a flag set in the routine rcrjrco for retransmission
|
|
; to prevent accepted fms documents from being resent
|
|
I '$G(RCRJFSV) D STARTSV^RCXFMSSV(DATEEND)
|
|
;
|
|
;
|
|
; ---------- send wr to fms ----------
|
|
; data stored in tmp($j,rcrjrcolwr)
|
|
; rcrjfwr is a flag set in the routine rcrjrco for retransmission
|
|
; to prevent accepted fms documents from being resent
|
|
I '$G(RCRJFWR) D STARTWR^RCXFMSWR(DATEEND)
|
|
;
|
|
; ---------- send tr to fms ----------
|
|
N RCTRANS
|
|
; this call returns rctrans array (see rcxfmstx for description)
|
|
; rcrjftr is a flag set in the routine rcrjrco for retransmission
|
|
; to prevent accepted fms documents from being resent
|
|
I '$G(RCRJFTR) D STARTTR^RCXFMSTX(DATEEND)
|
|
;
|
|
; ---------- send oig extract ----------
|
|
; data stored in tmp(j,rcrjroig)
|
|
; get non-mccf bills for extract and user report
|
|
D NONMCCF^RCRJROIG(DATEEND)
|
|
; rcrjfoig is a flag set in the routine rcrjrco for retransmission
|
|
; to prevent the oig extract from being resent
|
|
I '$G(RCRJFOIG) D OIG^RCRJROIG(DATEEND)
|
|
;
|
|
; generate a mailman message to the group showing the data
|
|
K ^TMP($J,"RCRJRCORMM")
|
|
S Y=$E(DATEEND,1,5)_"00" D DD^%DT S DATEMOYR=Y
|
|
S LINE=0,SPACE="",$P(SPACE," ",80)=""
|
|
D SET("Data has been collected for the month "_DATEMOYR_". The data has been")
|
|
D SET("transmitted to the following systems:")
|
|
D SET(" ")
|
|
;
|
|
I '$G(RCRJFAR1) D
|
|
. D SET("NATIONAL DATABASE DATA")
|
|
. D SET("----------------------")
|
|
. D SET("The data has been sent to the National Database. For a detail list")
|
|
. D SET("of the data sent, please review the Return Reports which are sent")
|
|
. D SET("from the National Database.")
|
|
. D SET(" ")
|
|
;
|
|
I '$G(RCRJFSV) D
|
|
. D SET("FMS, STANDARD VOUCHER (SV) DOCUMENT")
|
|
. D SET("-----------------------------------")
|
|
. D SET("The following data has been transmitted to FMS in the SV document:")
|
|
. D SET(" Revenue Source Code Type Amount")
|
|
. D SET(" ------------------- ---- ------")
|
|
. S TOTAL=0
|
|
. S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLSV",TYPE)) Q:TYPE="" D
|
|
. . I TYPE=17!(TYPE=18) Q ; display the Medicare totals later
|
|
. . S TOTALTYP=0
|
|
. . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND)) Q:FUND="" D
|
|
. . . S TOTALFUN=0
|
|
. . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLSV",TYPE,FUND,RSC)) Q:RSC="" S AMOUNT=^(RSC) D
|
|
. . . . D SET(" "_RSC_" "_$E($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$J(AMOUNT,13,2))
|
|
. . . . S TOTALFUN=TOTALFUN+AMOUNT
|
|
. . . . S TOTALTYP=TOTALTYP+AMOUNT
|
|
. . . . S TOTAL=TOTAL+AMOUNT
|
|
. . . ;
|
|
. . . 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))
|
|
. . . I TYPE=21 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
|
|
. . ;
|
|
. . D SET(" ----------")
|
|
. . D SET(" TOTAL TYPE "_TYPE_$J(TOTALTYP,13,2))
|
|
. . D SET(" ")
|
|
. ;
|
|
. ; Display Medicare totals and update the SV total
|
|
. S AMOUNT=+$G(^TMP($J,"RCRJRCOLSV",17)),TOTAL=TOTAL+AMOUNT
|
|
. D SET(" Medicare Contractual Adjustment TOTAL TYPE 17"_$J(AMOUNT,13,2))
|
|
. S AMOUNT=+$G(^TMP($J,"RCRJRCOLSV",18)),TOTAL=TOTAL+AMOUNT
|
|
. D SET(" Unreimbursable Medicare Expense TOTAL TYPE 18"_$J(AMOUNT,13,2))
|
|
. D SET(" ")
|
|
. ;
|
|
. D SET(" ----------")
|
|
. D SET(" TOTAL SV"_$J(TOTAL,13,2))
|
|
. D SET(" ")
|
|
;
|
|
I '$G(RCRJFWR) D
|
|
. D SET("FMS, WRITEOFFS/CONTRACT ADJUSTMENTS (WR) DOCUMENT")
|
|
. D SET("-------------------------------------------------")
|
|
. D SET("The following data has been transmitted to FMS in the WR document:")
|
|
. D SET(" Revenue Source Code Type Amount")
|
|
. D SET(" ------------------- ---- ------")
|
|
. S TOTAL=0
|
|
. S TYPE="" F S TYPE=$O(^TMP($J,"RCRJRCOLWR",TYPE)) Q:TYPE="" D
|
|
. . S TOTALTYP=0
|
|
. . S FUND="" F S FUND=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND)) Q:FUND="" D
|
|
. . . S TOTALFUN=0
|
|
. . . S RSC="" F S RSC=$O(^TMP($J,"RCRJRCOLWR",TYPE,FUND,RSC)) Q:RSC="" S AMOUNT=^(RSC) D
|
|
. . . . D SET(" "_RSC_" "_$E($$GETDESC^RCXFMSPR(RSC)_SPACE,1,54)_" "_TYPE_$J(AMOUNT,13,2))
|
|
. . . . S TOTALFUN=TOTALFUN+AMOUNT
|
|
. . . . S TOTALTYP=TOTALTYP+AMOUNT
|
|
. . . . S TOTAL=TOTAL+AMOUNT
|
|
. . . ;
|
|
. . . 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))
|
|
. . . I TYPE=37 D SET($E(" Sub-Total by Fund "_RCFUND_":"_SPACE,1,38)_$J(TOTALFUN,12,2))
|
|
. . ;
|
|
. . D SET(" ----------")
|
|
. . D SET(" TOTAL TYPE "_TYPE_$J(TOTALTYP,13,2))
|
|
. . D SET(" ")
|
|
. D SET(" ----------")
|
|
. D SET(" TOTAL WR"_$J(TOTAL,13,2))
|
|
. D SET(" ")
|
|
;
|
|
I '$G(RCRJFTR) D
|
|
. D SET("FMS, TRANSFER FROM MCCF TO HSIF (TR) DOCUMENT")
|
|
. D SET("-------------------------------------------------")
|
|
. D SET("The following data has been transmitted to FMS in the TR document:")
|
|
. D SET(" From Fund From RSC To Fund To RSC Amount")
|
|
. D SET(" --------- -------- ------- ------ ----------")
|
|
. I $O(RCTRANS(""))="" D SET(" No Dollars to Transfer.") Q
|
|
. ;
|
|
. S FUND="" F S FUND=$O(RCTRANS(FUND)) Q:FUND="" D
|
|
. . S RSC="" F S RSC=$O(RCTRANS(FUND,RSC)) Q:RSC="" D
|
|
. . . ; rctrans(fromfund,fromrsc) = tofund ^ torsc ^ amount
|
|
. . . S AMOUNT=RCTRANS(FUND,RSC)
|
|
. . . D SET($J(FUND,11)_$J(RSC,12)_$J($P(AMOUNT,"^"),14)_$J($P(AMOUNT,"^",2),10)_$J($P(AMOUNT,"^",3),31,2))
|
|
;
|
|
S XMY("G.RC AR DATA COLLECTOR")=""
|
|
S %=$$SENDMSG("AR Data Collector for "_DATEMOYR_" Station "_PRCASITE,.XMY)
|
|
K ^TMP($J,"RCRJRCORMM")
|
|
;
|
|
; send users detail report
|
|
D USERREPT^RCRJRCOU(DATEMOYR)
|
|
Q
|
|
;
|
|
;
|
|
NDB(PRCASITE,DATEBEG,DATEEND) ; send data to the national database
|
|
N %,BATCNAME,COUNT,CRITERIA,DATA,LINE,XMY,X,Y
|
|
K ^TMP($J,"RCRJRCORMM")
|
|
S LINE=2,DATA="D$ "
|
|
S CRITERIA="" F COUNT=1:1 S CRITERIA=$O(^TMP($J,"RCRJRCOLNDB",CRITERIA)) Q:CRITERIA="" D
|
|
. S DATA=DATA_":"_COUNT_"/"_CRITERIA_"/"_^TMP($J,"RCRJRCOLNDB",CRITERIA)
|
|
. I $L(DATA)>200 D SET(DATA) S DATA="D$ "
|
|
I DATA'="D$ " D SET(DATA)
|
|
;
|
|
; build the first two control lines in mail message
|
|
S Y=DATEBEG D DD^%DT
|
|
S BATCNAME="AR1-"_$E(Y,1,3)_$E(DATEBEG,6,7)_$TR($P(Y,",",2)," ")
|
|
S Y=DATEEND D DD^%DT
|
|
S BATCNAME=BATCNAME_"-"_$E(Y,1,3)_$E(DATEEND,6,7)_$TR($P(Y,",",2)," ")
|
|
S ^TMP($J,"RCRJRCORMM",1)="T$ "_PRCASITE_"$"_BATCNAME_"$$$$$*"
|
|
; get end time (in %)
|
|
D NOW^%DTC
|
|
S ^TMP($J,"RCRJRCORMM",2)="S$ "_STRTTIME_"^"_%_"$0$"_(COUNT-1)
|
|
;
|
|
S XMY("S.PRQN DATA COLLECTION MONITOR@FO-ALBANY.MED.VA.GOV")=""
|
|
S %=$$SENDMSG("AR1 "_$E(DATEEND,4,5)_"/"_$E(DATEEND,2,3)_" NDB DATA FOR SITE "_PRCASITE,.XMY)
|
|
K ^TMP($J,"RCRJRCORMM")
|
|
Q
|
|
;
|
|
;
|
|
SUMMARY ; print summary report in mailman bulletin
|
|
N %,BILLDA,CRITER2,CRITERIA,DATA0,DFN,LINE,STAT,TOTAL,VA,XMY
|
|
K ^TMP($J,"RCRJRCOR") ; used to identify test patients
|
|
K ^TMP($J,"RCRJRCORMM") ; used to build mailman message
|
|
;
|
|
; print any test patient bills which have not been closed
|
|
S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJRCOL","CRIT2",1,BILLDA)) Q:'BILLDA I $D(^(BILLDA,1)) D
|
|
. S DATA0=$G(^PRCA(430,BILLDA,0)),STAT=$P(DATA0,"^",8)
|
|
. I STAT'=16,STAT='42 Q ; bill not currently open
|
|
. S DFN=+$P(DATA0,"^",7) I 'DFN Q
|
|
. D PID^VADPT
|
|
. I $E($TR($G(VA("PID")),"-"),1,5)="00000" S ^TMP($J,"RCRJRCOR","TEST",BILLDA)=""
|
|
;
|
|
I '$D(^TMP($J,"RCRJRCOR","TEST")) Q
|
|
;
|
|
; print data
|
|
S LINE=0
|
|
D SET(" ")
|
|
D SET("The following bills are active and linked to test patients:")
|
|
S BILLDA=0 F S BILLDA=$O(^TMP($J,"RCRJRCOR","TEST",BILLDA)) Q:'BILLDA D SET(" "_$P($G(^PRCA(430,BILLDA,0)),"^")_" (#",BILLDA_")")
|
|
;
|
|
S XMY("G.RC AR DATA COLLECTOR")=""
|
|
S %=$$SENDMSG("MCCR DATA COLLECTOR INFORMATION",.XMY)
|
|
K ^TMP($J,"RCRJRCOR")
|
|
K ^TMP($J,"RCRJRCORMM")
|
|
Q
|
|
;
|
|
;
|
|
SET(DATA) ; store report
|
|
S LINE=LINE+1,^TMP($J,"RCRJRCORMM",LINE)=DATA
|
|
Q
|
|
;
|
|
;
|
|
SENDMSG(XMSUB,XMY) ; send message with subject and recipients
|
|
N %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
|
|
S XMDUZ="AR PACKAGE",XMTEXT="^TMP($J,""RCRJRCORMM"","
|
|
D ^XMD
|
|
Q +$G(XMZ)
|