Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCRJRCOR

RCRJRCOR.m

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