RCDPENR1 ;ALB/SAB - EPay National Reports ;12/10/14
;;4.5;Accounts Receivable;**304,359,349**;Mar 20, 1995;Build 44
;;Per VA Directive 6402, this routine should not be modified.
;
;PRCA*4.5*359 Do not process Bill/Claim that is Cancelled
; or does not have Provider pointer.
;Read ^DGCR(399) via Private IA 3820
;Read ^IBA(364) via Private IA 6209
;Read ^IBA(364.1) via Private IA 6210
;Use DIV^IBJDF2 via Private IA 3130
Q
;
; Entry point for manual run report (from VS option)
835837() ; 835-837 summary report
;
N RCBGDT,RCDISP,RCENDDT,RCPYRLST,RCDIV,RCRPT,RCRQDIV,RCSUMFLG,RCEX,RCPAYR
;
; Alert software to display to screen or not if Manually re-running the report.
S RCDISP=1
;
; Ask for Division
S RCRQDIV=$$GETDIV^RCDPENR4(.RCDIV) ; PRCA*4.5*349 - Moved from RCDPENR2 to RCDPENR4 due to size
Q:RCRQDIV=-1
;
S RCEX=$$GETPAY^RCDPENRU(.RCPAYR) Q:'RCEX
S RCPYRLST("START")=$P($G(RCPAYR("START")),U,4),RCPYRLST("END")=$P($G(RCPAYR("END")),U,4)
;
; Ask the user for report type, with no Main Prompt
S RCRPT=$$GETRPT^RCDPENR2(0)
Q:RCRPT=-1
;
S RCSUMFLG=$S(RCRPT="S":1,1:0)
;
; Retrieve start date
S RCBGDT=$$GETSDATE^RCDPENR2()
Q:RCBGDT=-1
;
; Retrieve end date. Send user start date as the lower bound.
S RCENDDT=$$GETEDATE^RCDPENR2(RCBGDT)
Q:RCENDDT=-1
D AUTO(RCDISP,RCBGDT,RCENDDT,.RCPYRLST,RCRQDIV,RCSUMFLG)
Q
;
;Entry Point for automated calls
AUTO(RCDISP,RCBGDT,RCENDDT,RCPYRLST,RCRQDIV,RCSUMFLG) ;
; RCDISP - Display results to screen or archive file flag
; RCBGDT - begin date of the report
; RCENDDT - End date of the report
; RCPYRLST - Payers to report on (All, range, or single payer)
; RCRQDIV - Division to report on - (A)ll or a single division
; RCSUMFLG - (S)ummary or (G)rand Total Report
;
;Select output device
I RCDISP S %ZIS="QM" D ^%ZIS Q:POP
;Option to queue
I 'RCDISP,$D(IO("Q")) D Q
.N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
.S ZTRTN="REPORT^RCDPENR1"
.S ZTDESC="EDI Volume Statistics Report"
.S ZTSAVE("RC*")=""
.D ^%ZTLOAD
.I $D(ZTSK) W !!,"Task number "_ZTSK_" has been queued."
.E W !!,"Unable to queue this job."
.K ZTSK,IO("Q") D HOME^%ZIS
;
;Compile and Print Report
D REPORT
Q
;
REPORT ; Trace the ERA file for the given date range
;
N RCPYRS,RCINS,RCDATA,RCDTLDT,RCDTLIEN,RCIEN,RCEOB,RCBILLNO,RCBATCH,RCTYPE,RCPHARM
;
; Clear temp arrays
K ^TMP("RCDPEADP",$J),^TMP("RCDPENR1",$J),^TMP("RCDPENR2",$J)
;
; Compile list of divisions
D DIV^RCDPENR4(.RCDIV) ; PRCA*4.5*349 - Moved from RCDPENR2 to RCDPENR4 due to size
;
; Compile the list of payers
D PYRARY^RCDPENRU(RCPYRLST("START"),RCPYRLST("END"),2) ; use 835 insurance file payer list
;
; Compile report
; Gather raw data
D GET837(RCBGDT,RCENDDT,RCSUMFLG)
D GETNCPDP(RCBGDT,RCENDDT,RCSUMFLG)
D GET835(RCBGDT,RCENDDT,RCSUMFLG)
;
;Check for data captures
I '$D(^TMP("RCDPENR1",$J)) D Q
. W !!,"There was no data available for the requested report. Please try again."
;
;Generate the statistics if any data captured
D COMPILE(RCSUMFLG)
;
; Print out the results
D PRINT(RCSUMFLG)
;
Q
;
;Generate the needed statistics for the report
COMPILE(RCSUMFLG) ;
;
; Temp Array Structure - ^TMP("RCDPENR1",$J,"CLAIM",RCMP,RCPAYER,RCCLAIM)=Send Date^Receive Date
N RCMP,RCTOT,RCTDAYS,RCDATA,RCSDATE,RCEDATE,RCCLAIM,RCPAYER,RCDAYS,RCMCT,RCPCT,RCIDX,RCTYPE
;
; Generate Grand Totals
S RCMP=""
F S RCMP=$O(^TMP("RCDPENR1",$J,"CLAIM",RCMP)) Q:RCMP="" D
. S RCPAYER=""
. F S RCPAYER=$O(^TMP("RCDPENR1",$J,"CLAIM",RCMP,RCPAYER)) Q:RCPAYER="" D
. . S RCCLAIM=""
. . F S RCCLAIM=$O(^TMP("RCDPENR1",$J,"CLAIM",RCMP,RCPAYER,RCCLAIM)) Q:RCCLAIM="" D
. . . S RCDATA=$G(^TMP("RCDPENR1",$J,"CLAIM",RCMP,RCPAYER,RCCLAIM))
. . . Q:RCDATA=""
. . . S RCSDATE=$P(RCDATA,U),RCEDATE=$P(RCDATA,U,2)
. . . Q:(RCSDATE="")&(RCEDATE="")
. . . I RCSDATE'="" D
. . . . S ^TMP("RCDPENR1",$J,"RCTOT","837",RCMP,"G")=+$G(^TMP("RCDPENR1",$J,"RCTOT","837",RCMP,"G"))+1
. . . . S:RCSUMFLG ^TMP("RCDPENR1",$J,"RCTOT","SUMMARY","837",RCMP,RCPAYER)=+$G(^TMP("RCDPENR1",$J,"RCTOT","SUMMARY","837",RCMP,RCPAYER))+1
. . . ;
. . . I RCEDATE'="" D
. . . . S ^TMP("RCDPENR1",$J,"RCTOT","835",RCMP,"G")=+$G(^TMP("RCDPENR1",$J,"RCTOT","835",RCMP,"G"))+1
. . . . S:RCSUMFLG ^TMP("RCDPENR1",$J,"RCTOT","SUMMARY","835",RCMP,RCPAYER)=+$G(^TMP("RCDPENR1",$J,"RCTOT","SUMMARY","835",RCMP,RCPAYER))+1
. . . ;
. . . I (RCSDATE'="")&(RCEDATE'="") D
. . . . S RCDAYS=$$FMTH^XLFDT(RCEDATE,1)-$$FMTH^XLFDT(RCSDATE,1)
. . . . ;
. . . . ; update counters for grand total report
. . . . S ^TMP("RCDPENR1",$J,"RCTDAYS","BOTH",RCMP,"G")=+$G(^TMP("RCDPENR1",$J,"RCTDAYS","BOTH",RCMP,"G"))+RCDAYS
. . . . S ^TMP("RCDPENR1",$J,"RCTOT","BOTH",RCMP,"G")=+$G(^TMP("RCDPENR1",$J,"RCTOT","BOTH",RCMP,"G"))+1
. . . . ;
. . . . ; update counters for the payer summary totals, if requested
. . . . I RCSUMFLG D
. . . . . S ^TMP("RCDPENR1",$J,"RCTOT","SUMMARY","BOTH",RCMP,RCPAYER)=+$G(^TMP("RCDPENR1",$J,"RCTOT","SUMMARY","BOTH",RCMP,RCPAYER))+1
. . . . . S ^TMP("RCDPENR1",$J,"RCTDAYS","SUMMARY","BOTH",RCMP,RCPAYER)=+$G(^TMP("RCDPENR1",$J,"RCTDAYS","SUMMARY","BOTH",RCMP,RCPAYER))+RCDAYS
;
;Calculate data for the report
;
;Get the grand total counts for the claims with both 837s and 835s
S RCMCT=+$G(^TMP("RCDPENR1",$J,"RCTOT","BOTH","M","G"))
S RCPCT=+$G(^TMP("RCDPENR1",$J,"RCTOT","BOTH","P","G"))
;
;Grand Totals
S RCDATA=""
S $P(RCDATA,U)=+$G(^TMP("RCDPENR1",$J,"RCTOT","837","M","G"))
S $P(RCDATA,U,2)=+$G(^TMP("RCDPENR1",$J,"RCTOT","837","P","G"))
S $P(RCDATA,U,3)=+$G(^TMP("RCDPENR1",$J,"RCTOT","835","M","G"))
S $P(RCDATA,U,4)=+$G(^TMP("RCDPENR1",$J,"RCTOT","835","P","G"))
S $P(RCDATA,U,5)=+$G(^TMP("RCDPENR1",$J,"RCTOT","BOTH","M","G"))
S $P(RCDATA,U,6)=+$G(^TMP("RCDPENR1",$J,"RCTOT","BOTH","P","G"))
S $P(RCDATA,U,7)=+$S(+RCMCT:+$G(^TMP("RCDPENR1",$J,"RCTDAYS","BOTH","M","G"))/+RCMCT,1:0)
S $P(RCDATA,U,8)=+$S(+RCPCT:+$G(^TMP("RCDPENR1",$J,"RCTDAYS","BOTH","P","G"))/+RCPCT,1:0)
S ^TMP("RCDPENR1",$J,"GTOT")=RCDATA
;
;quit if no Payer Summary
Q:'RCSUMFLG
;
;Generate Payer level information.
;first the Totals
S RCTYPE=""
F S RCTYPE=$O(^TMP("RCDPENR1",$J,"RCTOT","SUMMARY",RCTYPE)) Q:RCTYPE="" D
. S RCMP=""
. F S RCMP=$O(^TMP("RCDPENR1",$J,"RCTOT","SUMMARY",RCTYPE,RCMP)) Q:RCMP="" D
. . S RCPAYER=""
. . F S RCPAYER=$O(^TMP("RCDPENR1",$J,"RCTOT","SUMMARY",RCTYPE,RCMP,RCPAYER)) Q:RCPAYER="" D
. . . S RCIDX=$S(RCTYPE="837":1,RCTYPE="835":3,1:5)
. . . S:RCMP="P" RCIDX=RCIDX+1
. . . S $P(^TMP("RCDPENR1",$J,"SUMMARY",RCPAYER),U,RCIDX)=+$G(^TMP("RCDPENR1",$J,"RCTOT","SUMMARY",RCTYPE,RCMP,RCPAYER))
;
; Next, the total days count
S RCMP=""
F S RCMP=$O(^TMP("RCDPENR1",$J,"RCTDAYS","SUMMARY","BOTH",RCMP)) Q:RCMP="" D
. S RCPAYER=""
. F S RCPAYER=$O(^TMP("RCDPENR1",$J,"RCTDAYS","SUMMARY","BOTH",RCMP,RCPAYER)) Q:RCPAYER="" D
. . S RCIDX=$S(RCMP="M":7,1:8)
. . S $P(^TMP("RCDPENR1",$J,"SUMMARY",RCPAYER),U,RCIDX)=+$G(^TMP("RCDPENR1",$J,"RCTDAYS","SUMMARY","BOTH",RCMP,RCPAYER))
;
Q
;
;Print the results. Send via e-mail if not displaying to screen
PRINT(RCSUMFLG) ;Print the results
;
N RCSTOP,RCPAGE,RCLINE,RCRUNDT,RCRPIEN,RCXMZ,RCTFLG,RCFLG
;
S RCLINE="",$P(RCLINE,"-",IOM)="",RCTFLG=0,RCRPIEN="",RCFLG=0
;
; Init the stop flag, page count
S RCSTOP=0,RCPAGE=0
;
; Set the Run date for the report
S RCRUNDT=$$FMTE^XLFDT($$NOW^XLFDT,2)
;
; Open the device
I RCDISP U IO
;
I 'RCDISP D Q:'RCRPIEN
. S RCRPIEN=$$INITARCH("VOLUME STATISTICS")
;
; Display Header
D HEADER
;
; Display the detail
I RCSUMFLG S RCTFLG=1 S RCFLG=$$SUMMARY(RCTFLG)
Q:RCFLG=-1
;
; Display the grand total at the end
D GRAND(RCTFLG)
;
; If not displaying to screen and not redoing, send
I 'RCDISP D
. S RCXMZ=$$XM^RCDPENRU(RCRPIEN,RCBGDT,RCENDDT,"AR VOLUME STATISTICS REPORT")
;
;Report finished
I 'RCSTOP D
. I RCDISP,$Y>(IOSL-6) D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER
. I 'RCSTOP,RCDISP W !,$$ENDORPRT^RCDPEARL
W !
;
;Close device
I '$D(ZTQUEUED) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
Q
;
N RCDIVTXT,RCPYRTXT,RCSPACE,RCDATE,RCSTR
;
S RCSPACE=""
S $P(RCSPACE," ",80)=""
S RCDIVTXT=$$DIVTXT()
S RCPYRTXT=$$PAYERTXT(36)
S RCDATE="DATE RANGE: "_$$FMTE^XLFDT(RCBGDT,2)_" - "_$$FMTE^XLFDT(RCENDDT,2)
;
RPTHDR ;
S RCPAGE=RCPAGE+1
I RCDISP D Q
. W @IOF,?15,"EDI VOLUME STATISTICS REPORT"
. W ?70,"PAGE ",$J(RCPAGE,3),!
. W ?5,RCDIVTXT,?41,RCPYRTXT,!
. W ?5,RCDATE,?52,"RUN DATE: ",RCRUNDT,!
. W RCLINE,!
I 'RCDISP D
. S RCSTR=RCDIVTXT_U_RCPYRTXT_U_RCDATE
. D SAVEDATA(RCSTR,RCRPIEN)
;
Q
;
;Determine the text to display for the division prompt
DIVTXT() ;
;
N RCDIV,RCTXT
;
Q:$D(^TMP("RCDPENR2",$J,"DIVALL")) "ALL DIVISIONS"
;
;Build list of divisions
;
S RCDIV="",RCTXT=""
F S RCDIV=$O(^TMP("RCDPENR2",$J,"DIV",RCDIV)) Q:RCDIV="" D
. S RCTXT=RCTXT_RCDIV_","
;
; Remove comma at the end.
S RCTXT=$E(RCTXT,1,$L(RCTXT)-1)
I $L(RCTXT)>35 S RCTXT="SELECTED DIVISIONS"
;
Q RCTXT
;
;Determine the text to display for the division prompt
PAYERTXT(RCFILE) ;
;
N RCINS,RCTXT
;
;If all payers selected, return that message
Q:$D(^TMP("RCDPEADP",$J,"INS","A")) "ALL PAYERS"
;
; Build the list of payers
S RCINS="",RCTXT=""
F S RCINS=$O(^TMP("RCDPEADP",$J,"INS",RCINS)) Q:RCINS="" D
. S RCTXT=RCTXT_$$GET1^DIQ(RCFILE,RCINS_",",".01","E")_","
;
; Remove comma at the end.
S RCTXT=$E(RCTXT,1,$L(RCTXT)-1)
;
; Display the first 35 characters of the division text list,
Q $E(RCTXT,1,35)
;
SUMMARY(RCTFLG) ;Print the Payer Summary portion of the report
;
N RCINS,RCLPDATA,RC835,RC837,RCDTPCT,RCFLG
;
S RCINS=0,RCFLG=1
F S RCINS=$O(^TMP("RCDPENR1",$J,"SUMMARY",RCINS)) Q:RCINS="" D Q:RCFLG=-1
. S RCLPDATA=$G(^TMP("RCDPENR1",$J,"SUMMARY",RCINS))
. S RCFLG=$$PRINTRP^RCDPENR4("PAYER NAME: "_RCINS,RCLPDATA,RCRPIEN,RCDISP,RCTFLG)
Q RCFLG
;
;Total for all payers in report
GRAND(RCTFLG) ;
;
N RCDATA,RCFLG
;
S RCDATA=$G(^TMP("RCDPENR1",$J,"GTOT"))
S RCFLG=$$PRINTRP^RCDPENR4("GRAND TOTAL ALL PAYERS",RCDATA,RCRPIEN,RCDISP,RCTFLG)
Q
;
; Retrieve the needed 835 information.
GET835(RCSDATE,RCEDATE,RCSUMFLG) ;
;
N RCLDATE,RCBDIV,RCIEN,RCDATA,RCLIEN,RCDTLDT,RCEOB,RCBILL,RCMP
;
S RCLDATE=RCSDATE-.001
;
F S RCLDATE=$O(^RCY(344.4,"AFD",RCLDATE)) Q:RCLDATE>RCEDATE Q:RCLDATE="" D
. S RCIEN=""
. F S RCIEN=$O(^RCY(344.4,"AFD",RCLDATE,RCIEN)) Q:'RCIEN D Q
.. S RCDATA=$G(^RCY(344.4,RCIEN,0))
.. Q:RCDATA="" ;No data defined in the transaction
.. Q:'$P(RCDATA,U,10) ;Transaction is an MRA
.. S RCLIEN=0
.. F S RCLIEN=$O(^RCY(344.4,RCIEN,1,RCLIEN)) Q:RCLIEN="" D Q
... S RCDTLDT=$G(^RCY(344.4,RCIEN,1,RCLIEN,0)) ;Get the ERA Detail
... Q:RCDTLDT="" ;Quit if no ERA Detail
... S RCEOB=$P(RCDTLDT,U,2) ;Get the EOB info
... Q:'RCEOB ;quit if no info
... ;
... ; Get the BILL/CLAIM IEN from the #399 file
... S RCBILL=$$BILLIEN(RCEOB)
... Q:RCBILL="" ;EEOB corrupted, quit
... ;
... ;Get the insurance companY
... S RCINS=$$GET1^DIQ(361.1,RCEOB_",",.02,"I") ;Get the insurance company ID.
... S RCPAYER=$$GET1^DIQ(361.1,RCEOB_",",.02,"E") ;Get the insurance company ID.
... Q:RCPAYER=""
... ;
... ; If payer not in list, then exit.
... Q:'$$INSCHK^RCDPENRU(RCINS)
... ;
... ; Get the division
... S RCBDIV=$$DIV^IBJDF2(RCBILL)
... ;
... ; Quit if user specified a specific division and bill is not in that Division
... I '$D(^TMP("RCDPENR2",$J,"DIVALL"))&'$D(^TMP("RCDPENR2",$J,"DIV",RCBDIV)) Q
... ;
... ; Check to see if it is an ERA for a pharmacy claim or a medical claim
... S RCMP=$S($$PHARM^RCDPEWLP(RCIEN):"P",1:"M")
... ;
... D UPDTMP8(RCLDATE,RCMP,RCBILL,RCSUMFLG,RCPAYER,RCEOB)
Q
;
BILLIEN(RCEOB) ; Retrieve the IEN for the Bill attached to the EOB
; To find the external Bill number, please use GETBILL^RCDPESR0
;
Q $$GET1^DIQ(361.1,RCEOB_",",.01,"I")
;
;Retrieve all necessary information for the 837s sent during the requested period by
;using the 837 Transmission batches.
GET837(RCSDATE,RCEDATE,RCSUMFLG) ;
;RCSDATE - Start date of extraction
;RCEDATE - End date of extraction
;RCSUMFLG - Type of report (Payer Summary or Grand Total)
;
N RCBATCH,RCLDATE,RCPAYER,RCIEN,RCDATA,RCBILL,RCBDIV,RCINS
;
;Get the 837 batches sent within the given date range.
S RCLDATE=RCSDATE-.001
;
F S RCLDATE=$O(^IBA(364.1,"FDATE",RCLDATE)) Q:RCLDATE="" Q:RCLDATE>RCEDATE D
. S RCBATCH=0
. F S RCBATCH=$O(^IBA(364.1,"FDATE",RCLDATE,RCBATCH)) Q:RCBATCH="" D
.. S RCINS=$$GET1^DIQ(364.1,RCBATCH_",",.12,"I")
.. S RCPAYER=$$GET1^DIQ(364.1,RCBATCH_",",.12,"E")
.. Q:RCPAYER=""
.. ;
.. ;If payer not in list, then exit.
.. Q:'$$INSCHK^RCDPENRU(RCINS)
.. ;
.. S RCIEN=0
.. F S RCIEN=$O(^IBA(364,"C",RCBATCH,RCIEN)) Q:RCIEN="" D
... S RCDATA=$G(^IBA(364,RCIEN,0))
... S RCBILL=$P(RCDATA,U) ; Get the Bill #
... Q:RCBILL="" ; Corrupted batch information, don't count toward totals.
... S RCBDIV=$$DIV^IBJDF2(RCBILL)
... ;
... ; Quit if user specified a specific division and bill is not in that Division
... I '$D(^TMP("RCDPENR2",$J,"DIVALL"))&'$D(^TMP("RCDPENR2",$J,"DIV",RCBDIV)) Q
... D UPDTMPB(RCLDATE,1,"M",RCBILL,RCSUMFLG,RCPAYER)
;
;Exit
Q
;
;Update the Temporary array with the Billing information.
UPDTMPB(RCSEND,RCTOTFLG,RCMP,RCCLAIM,RCSUMFLG,RCPAYER) ;
; RCSEND - Date 837 or NCPDP sent from site.
; RCTOTFLG - Add to the total count or not (1 yes, 837 sent this period, 0 if 837 sent in prior period
; RCMP - Is this a (P)harmacy or (M)edical
; RCCLAIM - The IEN for the Bill/Claim
; RCSUMFLG - If this flag is 1, add payer level entry for the Payer Summary report, otherwise send 0 for Grand Total only
; RCPAYER - Payer for the claim (if generating a Payer Summary Report
;
;If the flag is 1, update the totals counter
S:RCTOTFLG ^TMP("RCDPENR1",$J,"TOTAL",RCMP)=$P($G(^TMP("RCDPENR1",$J,"TOTAL",RCMP)),U)+1
;
;Add the claim to the list with its send date.
S ^TMP("RCDPENR1",$J,"CLAIM",RCMP,RCPAYER,RCCLAIM)=RCSEND
;
;Add a payer level summation if producing a Payer Summary version of the report
S:(RCTOTFLG)&(RCSUMFLG) $P(^TMP("RCDPENR1",$J,"TOTAL",RCMP,RCPAYER),U)=$P($G(^TMP("RCDPENR1",$J,"TOTAL",RCMP,RCPAYER)),U)+1
;
Q
;
;Update the Temporary array with the 835 information.
UPDTMP8(RCRCVD,RCMP,RCCLAIM,RCSUMFLG,RCPAYER,RCEOB) ;
; RCRCVD - Date 835 is received.
; RCMP - Is this a (P)harmacy or (M)edical
; RCCLAIM - The IEN for the Bill/Claim
; RCSUMFLG - If this flag is 1, add payer level entry for the Payer Summary report, otherwise send 0 for Grand Total only
; RCPAYER - Payer for the claim (if generating a Payer Summary Report
; RCEOB - EOB IEN for the 361.1 file.
;
N RCSEND,RCBATCH
;
;If the flag is 1, update the totals counter
S ^TMP("RCDPENR1",$J,"TOTAL","835")=$G(^TMP("RCDPENR1",$J,"TOTAL","835"))+1
;
;If the claim/bill associated with the 835 isn't currently in temp array
; add it but don't update the count.
I '$D(^TMP("RCDPENR1",$J,"CLAIM",RCMP,RCPAYER,RCCLAIM)) D
. S RCBATCH=$$GET1^DIQ(361.1,RCEOB_",",100.02,"I")
. Q:RCBATCH=""
. S RCSEND=$$GET1^DIQ(364.1,RCBATCH_",",1.01,"I")
. D:RCSEND'="" UPDTMPB(RCSEND,0,RCMP,RCCLAIM,RCSUMFLG,RCPAYER)
;
;Add the claim to the list with its send date.
S $P(^TMP("RCDPENR1",$J,"CLAIM",RCMP,RCPAYER,RCCLAIM),U,2)=RCRCVD
;
;Add a payer level summation if producing a Payer Summary version of the report
S:RCSUMFLG $P(^TMP("RCDPENR1",$J,"TOTAL",RCMP,RCPAYER),U)=$P($G(^TMP("RCDPENR1",$J,"TOTAL",RCMP,RCPAYER)),U)+1
;
Q
;
; Retrieve the Pharmacy (NCPDP data) needed for the report
GETNCPDP(RCSDATE,RCEDATE,RCSUMFLG) ;
;
N RCLDATE,RCIEN,RCBILL,RCPAYER,RCFLAG,RCINS
;
; Loop through all of the bills received during the requested period.
S RCLDATE=RCSDATE-.001
;
F S RCLDATE=$O(^DGCR(399,"APD",RCLDATE)) Q:'RCLDATE Q:RCLDATE>RCEDATE D
. S RCIEN=0
. F S RCIEN=$O(^DGCR(399,"APD",RCLDATE,RCIEN)) Q:'RCIEN D
. . S RCFLAG=$$GETECME(RCIEN)
. . Q:RCFLAG="" ; No ECME number so not a Pharmacy bill
. . S RCPAYER=$$GET1^DIQ(399,RCIEN_",",101,"E") I $P(^DGCR(399,RCIEN,0),U,13)=7!'RCPAYER Q ;PRCA*4.5*359
. . S RCINS=$$GET1^DIQ(399,RCIEN_",",101,"I")
. . Q:'$$INSCHK^RCDPENRU(RCINS) ;Dont add if not on approved insurance list
. . D UPDTMPB(RCLDATE,1,"P",RCIEN,RCSUMFLG,RCPAYER)
;
;Exit
Q
;
; Get the ECME# from the bill
GETECME(RCIEN) ;
; Used by:
; Routine RCDPENR1
; Routine PRCABJ1
Q $$GET1^DIQ(399,RCIEN_",",460,"E")
;
;Save a line of data to the Archive file
SAVEDATA(RCDATA,IEN) ;
;
N RCARY,IENS
;
S IENS="+1,"_IEN_","
S RCARY(344.911,IENS,.01)=RCDATA
D UPDATE^DIE(,"RCARY")
;
Q
;
;Initialize the Archive file entry
INITARCH(RPT) ;
;
N FDA,FDAIEN,DT,DT1
;
S DT=$$NOW^XLFDT
S DT1=$E(DT,1,5)_"00"
;
; set up array
S FDA(344.91,"+1,",.01)=RPT ;Name of report
S FDA(344.91,"+1,",.02)=DT1 ;Month/year report run
S FDA(344.91,"+1,",.03)=1 ;Status
S FDA(344.91,"+1,",.04)=DT ;Start date of report
;
;file entry
D UPDATE^DIE(,"FDA","FDAIEN")
;
Q +$G(FDAIEN(1))
;
;Entry point for reprinting the header.
REPRINT(RCHDR,RCDATA) ;
;
N RCDIVTXT,RCPYRTXT,RCSPACE,RCDATE,RCSTR,RCRUNDT,RCLINE,RCFLG
S RCLINE="",$P(RCLINE,"-",IOM)=""
;
; Store the header into the correct variables
S RCSPACE=""
S $P(RCSPACE," ",80)=""
S RCDIVTXT=$P(RCHDR,U)
S RCPYRTXT=$P(RCHDR,U,2)
S RCDATE=$P(RCHDR,U,3)
S RCRUNDT=$$FMTE^XLFDT($$NOW^XLFDT,2)
;
; Call the Header Print routine
D RPTHDR
;
; Reprint the body
S RCFLG=$$PRINTRP^RCDPENR4("GRAND TOTAL ALL PAYERS",RCDATA,RCDISP)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENR1 18104 printed Apr 09, 2024@20:49:18 Page 2
RCDPENR1 ;ALB/SAB - EPay National Reports ;12/10/14
+1 ;;4.5;Accounts Receivable;**304,359,349**;Mar 20, 1995;Build 44
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;PRCA*4.5*359 Do not process Bill/Claim that is Cancelled
+5 ; or does not have Provider pointer.
+6 ;Read ^DGCR(399) via Private IA 3820
+7 ;Read ^IBA(364) via Private IA 6209
+8 ;Read ^IBA(364.1) via Private IA 6210
+9 ;Use DIV^IBJDF2 via Private IA 3130
+10 QUIT
+11 ;
+12 ; Entry point for manual run report (from VS option)
835837() ; 835-837 summary report
+1 ;
+2 NEW RCBGDT,RCDISP,RCENDDT,RCPYRLST,RCDIV,RCRPT,RCRQDIV,RCSUMFLG,RCEX,RCPAYR
+3 ;
+4 ; Alert software to display to screen or not if Manually re-running the report.
+5 SET RCDISP=1
+6 ;
+7 ; Ask for Division
+8 ; PRCA*4.5*349 - Moved from RCDPENR2 to RCDPENR4 due to size
SET RCRQDIV=$$GETDIV^RCDPENR4(.RCDIV)
+9 if RCRQDIV=-1
QUIT
+10 ;
+11 SET RCEX=$$GETPAY^RCDPENRU(.RCPAYR)
if 'RCEX
QUIT
+12 SET RCPYRLST("START")=$PIECE($GET(RCPAYR("START")),U,4)
SET RCPYRLST("END")=$PIECE($GET(RCPAYR("END")),U,4)
+13 ;
+14 ; Ask the user for report type, with no Main Prompt
+15 SET RCRPT=$$GETRPT^RCDPENR2(0)
+16 if RCRPT=-1
QUIT
+17 ;
+18 SET RCSUMFLG=$SELECT(RCRPT="S":1,1:0)
+19 ;
+20 ; Retrieve start date
+21 SET RCBGDT=$$GETSDATE^RCDPENR2()
+22 if RCBGDT=-1
QUIT
+23 ;
+24 ; Retrieve end date. Send user start date as the lower bound.
+25 SET RCENDDT=$$GETEDATE^RCDPENR2(RCBGDT)
+26 if RCENDDT=-1
QUIT
+27 DO AUTO(RCDISP,RCBGDT,RCENDDT,.RCPYRLST,RCRQDIV,RCSUMFLG)
+28 QUIT
+29 ;
+30 ;Entry Point for automated calls
AUTO(RCDISP,RCBGDT,RCENDDT,RCPYRLST,RCRQDIV,RCSUMFLG) ;
+1 ; RCDISP - Display results to screen or archive file flag
+2 ; RCBGDT - begin date of the report
+3 ; RCENDDT - End date of the report
+4 ; RCPYRLST - Payers to report on (All, range, or single payer)
+5 ; RCRQDIV - Division to report on - (A)ll or a single division
+6 ; RCSUMFLG - (S)ummary or (G)rand Total Report
+7 ;
+8 ;Select output device
+9 IF RCDISP
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+10 ;Option to queue
+11 IF 'RCDISP
IF $DATA(IO("Q"))
Begin DoDot:1
+12 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+13 SET ZTRTN="REPORT^RCDPENR1"
+14 SET ZTDESC="EDI Volume Statistics Report"
+15 SET ZTSAVE("RC*")=""
+16 DO ^%ZTLOAD
+17 IF $DATA(ZTSK)
WRITE !!,"Task number "_ZTSK_" has been queued."
+18 IF '$TEST
WRITE !!,"Unable to queue this job."
+19 KILL ZTSK,IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+20 ;
+21 ;Compile and Print Report
+22 DO REPORT
+23 QUIT
+24 ;
REPORT ; Trace the ERA file for the given date range
+1 ;
+2 NEW RCPYRS,RCINS,RCDATA,RCDTLDT,RCDTLIEN,RCIEN,RCEOB,RCBILLNO,RCBATCH,RCTYPE,RCPHARM
+3 ;
+4 ; Clear temp arrays
+5 KILL ^TMP("RCDPEADP",$JOB),^TMP("RCDPENR1",$JOB),^TMP("RCDPENR2",$JOB)
+6 ;
+7 ; Compile list of divisions
+8 ; PRCA*4.5*349 - Moved from RCDPENR2 to RCDPENR4 due to size
DO DIV^RCDPENR4(.RCDIV)
+9 ;
+10 ; Compile the list of payers
+11 ; use 835 insurance file payer list
DO PYRARY^RCDPENRU(RCPYRLST("START"),RCPYRLST("END"),2)
+12 ;
+13 ; Compile report
+14 ; Gather raw data
+15 DO GET837(RCBGDT,RCENDDT,RCSUMFLG)
+16 DO GETNCPDP(RCBGDT,RCENDDT,RCSUMFLG)
+17 DO GET835(RCBGDT,RCENDDT,RCSUMFLG)
+18 ;
+19 ;Check for data captures
+20 IF '$DATA(^TMP("RCDPENR1",$JOB))
Begin DoDot:1
+21 WRITE !!,"There was no data available for the requested report. Please try again."
End DoDot:1
QUIT
+22 ;
+23 ;Generate the statistics if any data captured
+24 DO COMPILE(RCSUMFLG)
+25 ;
+26 ; Print out the results
+27 DO PRINT(RCSUMFLG)
+28 ;
+29 QUIT
+30 ;
+31 ;Generate the needed statistics for the report
COMPILE(RCSUMFLG) ;
+1 ;
+2 ; Temp Array Structure - ^TMP("RCDPENR1",$J,"CLAIM",RCMP,RCPAYER,RCCLAIM)=Send Date^Receive Date
+3 NEW RCMP,RCTOT,RCTDAYS,RCDATA,RCSDATE,RCEDATE,RCCLAIM,RCPAYER,RCDAYS,RCMCT,RCPCT,RCIDX,RCTYPE
+4 ;
+5 ; Generate Grand Totals
+6 SET RCMP=""
+7 FOR
SET RCMP=$ORDER(^TMP("RCDPENR1",$JOB,"CLAIM",RCMP))
if RCMP=""
QUIT
Begin DoDot:1
+8 SET RCPAYER=""
+9 FOR
SET RCPAYER=$ORDER(^TMP("RCDPENR1",$JOB,"CLAIM",RCMP,RCPAYER))
if RCPAYER=""
QUIT
Begin DoDot:2
+10 SET RCCLAIM=""
+11 FOR
SET RCCLAIM=$ORDER(^TMP("RCDPENR1",$JOB,"CLAIM",RCMP,RCPAYER,RCCLAIM))
if RCCLAIM=""
QUIT
Begin DoDot:3
+12 SET RCDATA=$GET(^TMP("RCDPENR1",$JOB,"CLAIM",RCMP,RCPAYER,RCCLAIM))
+13 if RCDATA=""
QUIT
+14 SET RCSDATE=$PIECE(RCDATA,U)
SET RCEDATE=$PIECE(RCDATA,U,2)
+15 if (RCSDATE="")&(RCEDATE="")
QUIT
+16 IF RCSDATE'=""
Begin DoDot:4
+17 SET ^TMP("RCDPENR1",$JOB,"RCTOT","837",RCMP,"G")=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","837",RCMP,"G"))+1
+18 if RCSUMFLG
SET ^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY","837",RCMP,RCPAYER)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY","837",RCMP,RCPAYER))+1
End DoDot:4
+19 ;
+20 IF RCEDATE'=""
Begin DoDot:4
+21 SET ^TMP("RCDPENR1",$JOB,"RCTOT","835",RCMP,"G")=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","835",RCMP,"G"))+1
+22 if RCSUMFLG
SET ^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY","835",RCMP,RCPAYER)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY","835",RCMP,RCPAYER))+1
End DoDot:4
+23 ;
+24 IF (RCSDATE'="")&(RCEDATE'="")
Begin DoDot:4
+25 SET RCDAYS=$$FMTH^XLFDT(RCEDATE,1)-$$FMTH^XLFDT(RCSDATE,1)
+26 ;
+27 ; update counters for grand total report
+28 SET ^TMP("RCDPENR1",$JOB,"RCTDAYS","BOTH",RCMP,"G")=+$GET(^TMP("RCDPENR1",$JOB,"RCTDAYS","BOTH",RCMP,"G"))+RCDAYS
+29 SET ^TMP("RCDPENR1",$JOB,"RCTOT","BOTH",RCMP,"G")=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","BOTH",RCMP,"G"))+1
+30 ;
+31 ; update counters for the payer summary totals, if requested
+32 IF RCSUMFLG
Begin DoDot:5
+33 SET ^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY","BOTH",RCMP,RCPAYER)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY","BOTH",RCMP,RCPAYER))+1
+34 SET ^TMP("RCDPENR1",$JOB,"RCTDAYS","SUMMARY","BOTH",RCMP,RCPAYER)=+$GET(^TMP("RCDPENR1",$JOB,"RCTDAYS","SUMMARY","BOTH",RCMP,RCPAYER))+RCDAYS
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;
+36 ;Calculate data for the report
+37 ;
+38 ;Get the grand total counts for the claims with both 837s and 835s
+39 SET RCMCT=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","BOTH","M","G"))
+40 SET RCPCT=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","BOTH","P","G"))
+41 ;
+42 ;Grand Totals
+43 SET RCDATA=""
+44 SET $PIECE(RCDATA,U)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","837","M","G"))
+45 SET $PIECE(RCDATA,U,2)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","837","P","G"))
+46 SET $PIECE(RCDATA,U,3)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","835","M","G"))
+47 SET $PIECE(RCDATA,U,4)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","835","P","G"))
+48 SET $PIECE(RCDATA,U,5)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","BOTH","M","G"))
+49 SET $PIECE(RCDATA,U,6)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","BOTH","P","G"))
+50 SET $PIECE(RCDATA,U,7)=+$SELECT(+RCMCT:+$GET(^TMP("RCDPENR1",$JOB,"RCTDAYS","BOTH","M","G"))/+RCMCT,1:0)
+51 SET $PIECE(RCDATA,U,8)=+$SELECT(+RCPCT:+$GET(^TMP("RCDPENR1",$JOB,"RCTDAYS","BOTH","P","G"))/+RCPCT,1:0)
+52 SET ^TMP("RCDPENR1",$JOB,"GTOT")=RCDATA
+53 ;
+54 ;quit if no Payer Summary
+55 if 'RCSUMFLG
QUIT
+56 ;
+57 ;Generate Payer level information.
+58 ;first the Totals
+59 SET RCTYPE=""
+60 FOR
SET RCTYPE=$ORDER(^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY",RCTYPE))
if RCTYPE=""
QUIT
Begin DoDot:1
+61 SET RCMP=""
+62 FOR
SET RCMP=$ORDER(^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY",RCTYPE,RCMP))
if RCMP=""
QUIT
Begin DoDot:2
+63 SET RCPAYER=""
+64 FOR
SET RCPAYER=$ORDER(^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY",RCTYPE,RCMP,RCPAYER))
if RCPAYER=""
QUIT
Begin DoDot:3
+65 SET RCIDX=$SELECT(RCTYPE="837":1,RCTYPE="835":3,1:5)
+66 if RCMP="P"
SET RCIDX=RCIDX+1
+67 SET $PIECE(^TMP("RCDPENR1",$JOB,"SUMMARY",RCPAYER),U,RCIDX)=+$GET(^TMP("RCDPENR1",$JOB,"RCTOT","SUMMARY",RCTYPE,RCMP,RCPAYER))
End DoDot:3
End DoDot:2
End DoDot:1
+68 ;
+69 ; Next, the total days count
+70 SET RCMP=""
+71 FOR
SET RCMP=$ORDER(^TMP("RCDPENR1",$JOB,"RCTDAYS","SUMMARY","BOTH",RCMP))
if RCMP=""
QUIT
Begin DoDot:1
+72 SET RCPAYER=""
+73 FOR
SET RCPAYER=$ORDER(^TMP("RCDPENR1",$JOB,"RCTDAYS","SUMMARY","BOTH",RCMP,RCPAYER))
if RCPAYER=""
QUIT
Begin DoDot:2
+74 SET RCIDX=$SELECT(RCMP="M":7,1:8)
+75 SET $PIECE(^TMP("RCDPENR1",$JOB,"SUMMARY",RCPAYER),U,RCIDX)=+$GET(^TMP("RCDPENR1",$JOB,"RCTDAYS","SUMMARY","BOTH",RCMP,RCPAYER))
End DoDot:2
End DoDot:1
+76 ;
+77 QUIT
+78 ;
+79 ;Print the results. Send via e-mail if not displaying to screen
PRINT(RCSUMFLG) ;Print the results
+1 ;
+2 NEW RCSTOP,RCPAGE,RCLINE,RCRUNDT,RCRPIEN,RCXMZ,RCTFLG,RCFLG
+3 ;
+4 SET RCLINE=""
SET $PIECE(RCLINE,"-",IOM)=""
SET RCTFLG=0
SET RCRPIEN=""
SET RCFLG=0
+5 ;
+6 ; Init the stop flag, page count
+7 SET RCSTOP=0
SET RCPAGE=0
+8 ;
+9 ; Set the Run date for the report
+10 SET RCRUNDT=$$FMTE^XLFDT($$NOW^XLFDT,2)
+11 ;
+12 ; Open the device
+13 IF RCDISP
USE IO
+14 ;
+15 IF 'RCDISP
Begin DoDot:1
+16 SET RCRPIEN=$$INITARCH("VOLUME STATISTICS")
End DoDot:1
if 'RCRPIEN
QUIT
+17 ;
+18 ; Display Header
+19 DO HEADER
+20 ;
+21 ; Display the detail
+22 IF RCSUMFLG
SET RCTFLG=1
SET RCFLG=$$SUMMARY(RCTFLG)
+23 if RCFLG=-1
QUIT
+24 ;
+25 ; Display the grand total at the end
+26 DO GRAND(RCTFLG)
+27 ;
+28 ; If not displaying to screen and not redoing, send
+29 IF 'RCDISP
Begin DoDot:1
+30 SET RCXMZ=$$XM^RCDPENRU(RCRPIEN,RCBGDT,RCENDDT,"AR VOLUME STATISTICS REPORT")
End DoDot:1
+31 ;
+32 ;Report finished
+33 IF 'RCSTOP
Begin DoDot:1
+34 IF RCDISP
IF $Y>(IOSL-6)
DO ASK^RCDPEADP(.RCSTOP,0)
if RCSTOP
QUIT
DO HEADER
+35 IF 'RCSTOP
IF RCDISP
WRITE !,$$ENDORPRT^RCDPEARL
End DoDot:1
+36 WRITE !
+37 ;
+38 ;Close device
+39 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+40 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+41 QUIT
+42 ;
+43 QUIT
+1 ;
+2 NEW RCDIVTXT,RCPYRTXT,RCSPACE,RCDATE,RCSTR
+3 ;
+4 SET RCSPACE=""
+5 SET $PIECE(RCSPACE," ",80)=""
+6 SET RCDIVTXT=$$DIVTXT()
+7 SET RCPYRTXT=$$PAYERTXT(36)
+8 SET RCDATE="DATE RANGE: "_$$FMTE^XLFDT(RCBGDT,2)_" - "_$$FMTE^XLFDT(RCENDDT,2)
+9 ;
RPTHDR ;
+1 SET RCPAGE=RCPAGE+1
+2 IF RCDISP
Begin DoDot:1
+3 WRITE @IOF,?15,"EDI VOLUME STATISTICS REPORT"
+4 WRITE ?70,"PAGE ",$JUSTIFY(RCPAGE,3),!
+5 WRITE ?5,RCDIVTXT,?41,RCPYRTXT,!
+6 WRITE ?5,RCDATE,?52,"RUN DATE: ",RCRUNDT,!
+7 WRITE RCLINE,!
End DoDot:1
QUIT
+8 IF 'RCDISP
Begin DoDot:1
+9 SET RCSTR=RCDIVTXT_U_RCPYRTXT_U_RCDATE
+10 DO SAVEDATA(RCSTR,RCRPIEN)
End DoDot:1
+11 ;
+12 QUIT
+13 ;
+14 ;Determine the text to display for the division prompt
DIVTXT() ;
+1 ;
+2 NEW RCDIV,RCTXT
+3 ;
+4 if $DATA(^TMP("RCDPENR2",$JOB,"DIVALL"))
QUIT "ALL DIVISIONS"
+5 ;
+6 ;Build list of divisions
+7 ;
+8 SET RCDIV=""
SET RCTXT=""
+9 FOR
SET RCDIV=$ORDER(^TMP("RCDPENR2",$JOB,"DIV",RCDIV))
if RCDIV=""
QUIT
Begin DoDot:1
+10 SET RCTXT=RCTXT_RCDIV_","
End DoDot:1
+11 ;
+12 ; Remove comma at the end.
+13 SET RCTXT=$EXTRACT(RCTXT,1,$LENGTH(RCTXT)-1)
+14 IF $LENGTH(RCTXT)>35
SET RCTXT="SELECTED DIVISIONS"
+15 ;
+16 QUIT RCTXT
+17 ;
+18 ;Determine the text to display for the division prompt
PAYERTXT(RCFILE) ;
+1 ;
+2 NEW RCINS,RCTXT
+3 ;
+4 ;If all payers selected, return that message
+5 if $DATA(^TMP("RCDPEADP",$JOB,"INS","A"))
QUIT "ALL PAYERS"
+6 ;
+7 ; Build the list of payers
+8 SET RCINS=""
SET RCTXT=""
+9 FOR
SET RCINS=$ORDER(^TMP("RCDPEADP",$JOB,"INS",RCINS))
if RCINS=""
QUIT
Begin DoDot:1
+10 SET RCTXT=RCTXT_$$GET1^DIQ(RCFILE,RCINS_",",".01","E")_","
End DoDot:1
+11 ;
+12 ; Remove comma at the end.
+13 SET RCTXT=$EXTRACT(RCTXT,1,$LENGTH(RCTXT)-1)
+14 ;
+15 ; Display the first 35 characters of the division text list,
+16 QUIT $EXTRACT(RCTXT,1,35)
+17 ;
SUMMARY(RCTFLG) ;Print the Payer Summary portion of the report
+1 ;
+2 NEW RCINS,RCLPDATA,RC835,RC837,RCDTPCT,RCFLG
+3 ;
+4 SET RCINS=0
SET RCFLG=1
+5 FOR
SET RCINS=$ORDER(^TMP("RCDPENR1",$JOB,"SUMMARY",RCINS))
if RCINS=""
QUIT
Begin DoDot:1
+6 SET RCLPDATA=$GET(^TMP("RCDPENR1",$JOB,"SUMMARY",RCINS))
+7 SET RCFLG=$$PRINTRP^RCDPENR4("PAYER NAME: "_RCINS,RCLPDATA,RCRPIEN,RCDISP,RCTFLG)
End DoDot:1
if RCFLG=-1
QUIT
+8 QUIT RCFLG
+9 ;
+10 ;Total for all payers in report
GRAND(RCTFLG) ;
+1 ;
+2 NEW RCDATA,RCFLG
+3 ;
+4 SET RCDATA=$GET(^TMP("RCDPENR1",$JOB,"GTOT"))
+5 SET RCFLG=$$PRINTRP^RCDPENR4("GRAND TOTAL ALL PAYERS",RCDATA,RCRPIEN,RCDISP,RCTFLG)
+6 QUIT
+7 ;
+8 ; Retrieve the needed 835 information.
GET835(RCSDATE,RCEDATE,RCSUMFLG) ;
+1 ;
+2 NEW RCLDATE,RCBDIV,RCIEN,RCDATA,RCLIEN,RCDTLDT,RCEOB,RCBILL,RCMP
+3 ;
+4 SET RCLDATE=RCSDATE-.001
+5 ;
+6 FOR
SET RCLDATE=$ORDER(^RCY(344.4,"AFD",RCLDATE))
if RCLDATE>RCEDATE
QUIT
if RCLDATE=""
QUIT
Begin DoDot:1
+7 SET RCIEN=""
+8 FOR
SET RCIEN=$ORDER(^RCY(344.4,"AFD",RCLDATE,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:2
+9 SET RCDATA=$GET(^RCY(344.4,RCIEN,0))
+10 ;No data defined in the transaction
if RCDATA=""
QUIT
+11 ;Transaction is an MRA
if '$PIECE(RCDATA,U,10)
QUIT
+12 SET RCLIEN=0
+13 FOR
SET RCLIEN=$ORDER(^RCY(344.4,RCIEN,1,RCLIEN))
if RCLIEN=""
QUIT
Begin DoDot:3
+14 ;Get the ERA Detail
SET RCDTLDT=$GET(^RCY(344.4,RCIEN,1,RCLIEN,0))
+15 ;Quit if no ERA Detail
if RCDTLDT=""
QUIT
+16 ;Get the EOB info
SET RCEOB=$PIECE(RCDTLDT,U,2)
+17 ;quit if no info
if 'RCEOB
QUIT
+18 ;
+19 ; Get the BILL/CLAIM IEN from the #399 file
+20 SET RCBILL=$$BILLIEN(RCEOB)
+21 ;EEOB corrupted, quit
if RCBILL=""
QUIT
+22 ;
+23 ;Get the insurance companY
+24 ;Get the insurance company ID.
SET RCINS=$$GET1^DIQ(361.1,RCEOB_",",.02,"I")
+25 ;Get the insurance company ID.
SET RCPAYER=$$GET1^DIQ(361.1,RCEOB_",",.02,"E")
+26 if RCPAYER=""
QUIT
+27 ;
+28 ; If payer not in list, then exit.
+29 if '$$INSCHK^RCDPENRU(RCINS)
QUIT
+30 ;
+31 ; Get the division
+32 SET RCBDIV=$$DIV^IBJDF2(RCBILL)
+33 ;
+34 ; Quit if user specified a specific division and bill is not in that Division
+35 IF '$DATA(^TMP("RCDPENR2",$JOB,"DIVALL"))&'$DATA(^TMP("RCDPENR2",$JOB,"DIV",RCBDIV))
QUIT
+36 ;
+37 ; Check to see if it is an ERA for a pharmacy claim or a medical claim
+38 SET RCMP=$SELECT($$PHARM^RCDPEWLP(RCIEN):"P",1:"M")
+39 ;
+40 DO UPDTMP8(RCLDATE,RCMP,RCBILL,RCSUMFLG,RCPAYER,RCEOB)
End DoDot:3
QUIT
End DoDot:2
QUIT
End DoDot:1
+41 QUIT
+42 ;
BILLIEN(RCEOB) ; Retrieve the IEN for the Bill attached to the EOB
+1 ; To find the external Bill number, please use GETBILL^RCDPESR0
+2 ;
+3 QUIT $$GET1^DIQ(361.1,RCEOB_",",.01,"I")
+4 ;
+5 ;Retrieve all necessary information for the 837s sent during the requested period by
+6 ;using the 837 Transmission batches.
GET837(RCSDATE,RCEDATE,RCSUMFLG) ;
+1 ;RCSDATE - Start date of extraction
+2 ;RCEDATE - End date of extraction
+3 ;RCSUMFLG - Type of report (Payer Summary or Grand Total)
+4 ;
+5 NEW RCBATCH,RCLDATE,RCPAYER,RCIEN,RCDATA,RCBILL,RCBDIV,RCINS
+6 ;
+7 ;Get the 837 batches sent within the given date range.
+8 SET RCLDATE=RCSDATE-.001
+9 ;
+10 FOR
SET RCLDATE=$ORDER(^IBA(364.1,"FDATE",RCLDATE))
if RCLDATE=""
QUIT
if RCLDATE>RCEDATE
QUIT
Begin DoDot:1
+11 SET RCBATCH=0
+12 FOR
SET RCBATCH=$ORDER(^IBA(364.1,"FDATE",RCLDATE,RCBATCH))
if RCBATCH=""
QUIT
Begin DoDot:2
+13 SET RCINS=$$GET1^DIQ(364.1,RCBATCH_",",.12,"I")
+14 SET RCPAYER=$$GET1^DIQ(364.1,RCBATCH_",",.12,"E")
+15 if RCPAYER=""
QUIT
+16 ;
+17 ;If payer not in list, then exit.
+18 if '$$INSCHK^RCDPENRU(RCINS)
QUIT
+19 ;
+20 SET RCIEN=0
+21 FOR
SET RCIEN=$ORDER(^IBA(364,"C",RCBATCH,RCIEN))
if RCIEN=""
QUIT
Begin DoDot:3
+22 SET RCDATA=$GET(^IBA(364,RCIEN,0))
+23 ; Get the Bill #
SET RCBILL=$PIECE(RCDATA,U)
+24 ; Corrupted batch information, don't count toward totals.
if RCBILL=""
QUIT
+25 SET RCBDIV=$$DIV^IBJDF2(RCBILL)
+26 ;
+27 ; Quit if user specified a specific division and bill is not in that Division
+28 IF '$DATA(^TMP("RCDPENR2",$JOB,"DIVALL"))&'$DATA(^TMP("RCDPENR2",$JOB,"DIV",RCBDIV))
QUIT
+29 DO UPDTMPB(RCLDATE,1,"M",RCBILL,RCSUMFLG,RCPAYER)
End DoDot:3
End DoDot:2
End DoDot:1
+30 ;
+31 ;Exit
+32 QUIT
+33 ;
+34 ;Update the Temporary array with the Billing information.
UPDTMPB(RCSEND,RCTOTFLG,RCMP,RCCLAIM,RCSUMFLG,RCPAYER) ;
+1 ; RCSEND - Date 837 or NCPDP sent from site.
+2 ; RCTOTFLG - Add to the total count or not (1 yes, 837 sent this period, 0 if 837 sent in prior period
+3 ; RCMP - Is this a (P)harmacy or (M)edical
+4 ; RCCLAIM - The IEN for the Bill/Claim
+5 ; RCSUMFLG - If this flag is 1, add payer level entry for the Payer Summary report, otherwise send 0 for Grand Total only
+6 ; RCPAYER - Payer for the claim (if generating a Payer Summary Report
+7 ;
+8 ;If the flag is 1, update the totals counter
+9 if RCTOTFLG
SET ^TMP("RCDPENR1",$JOB,"TOTAL",RCMP)=$PIECE($GET(^TMP("RCDPENR1",$JOB,"TOTAL",RCMP)),U)+1
+10 ;
+11 ;Add the claim to the list with its send date.
+12 SET ^TMP("RCDPENR1",$JOB,"CLAIM",RCMP,RCPAYER,RCCLAIM)=RCSEND
+13 ;
+14 ;Add a payer level summation if producing a Payer Summary version of the report
+15 if (RCTOTFLG)&(RCSUMFLG)
SET $PIECE(^TMP("RCDPENR1",$JOB,"TOTAL",RCMP,RCPAYER),U)=$PIECE($GET(^TMP("RCDPENR1",$JOB,"TOTAL",RCMP,RCPAYER)),U)+1
+16 ;
+17 QUIT
+18 ;
+19 ;Update the Temporary array with the 835 information.
UPDTMP8(RCRCVD,RCMP,RCCLAIM,RCSUMFLG,RCPAYER,RCEOB) ;
+1 ; RCRCVD - Date 835 is received.
+2 ; RCMP - Is this a (P)harmacy or (M)edical
+3 ; RCCLAIM - The IEN for the Bill/Claim
+4 ; RCSUMFLG - If this flag is 1, add payer level entry for the Payer Summary report, otherwise send 0 for Grand Total only
+5 ; RCPAYER - Payer for the claim (if generating a Payer Summary Report
+6 ; RCEOB - EOB IEN for the 361.1 file.
+7 ;
+8 NEW RCSEND,RCBATCH
+9 ;
+10 ;If the flag is 1, update the totals counter
+11 SET ^TMP("RCDPENR1",$JOB,"TOTAL","835")=$GET(^TMP("RCDPENR1",$JOB,"TOTAL","835"))+1
+12 ;
+13 ;If the claim/bill associated with the 835 isn't currently in temp array
+14 ; add it but don't update the count.
+15 IF '$DATA(^TMP("RCDPENR1",$JOB,"CLAIM",RCMP,RCPAYER,RCCLAIM))
Begin DoDot:1
+16 SET RCBATCH=$$GET1^DIQ(361.1,RCEOB_",",100.02,"I")
+17 if RCBATCH=""
QUIT
+18 SET RCSEND=$$GET1^DIQ(364.1,RCBATCH_",",1.01,"I")
+19 if RCSEND'=""
DO UPDTMPB(RCSEND,0,RCMP,RCCLAIM,RCSUMFLG,RCPAYER)
End DoDot:1
+20 ;
+21 ;Add the claim to the list with its send date.
+22 SET $PIECE(^TMP("RCDPENR1",$JOB,"CLAIM",RCMP,RCPAYER,RCCLAIM),U,2)=RCRCVD
+23 ;
+24 ;Add a payer level summation if producing a Payer Summary version of the report
+25 if RCSUMFLG
SET $PIECE(^TMP("RCDPENR1",$JOB,"TOTAL",RCMP,RCPAYER),U)=$PIECE($GET(^TMP("RCDPENR1",$JOB,"TOTAL",RCMP,RCPAYER)),U)+1
+26 ;
+27 QUIT
+28 ;
+29 ; Retrieve the Pharmacy (NCPDP data) needed for the report
GETNCPDP(RCSDATE,RCEDATE,RCSUMFLG) ;
+1 ;
+2 NEW RCLDATE,RCIEN,RCBILL,RCPAYER,RCFLAG,RCINS
+3 ;
+4 ; Loop through all of the bills received during the requested period.
+5 SET RCLDATE=RCSDATE-.001
+6 ;
+7 FOR
SET RCLDATE=$ORDER(^DGCR(399,"APD",RCLDATE))
if 'RCLDATE
QUIT
if RCLDATE>RCEDATE
QUIT
Begin DoDot:1
+8 SET RCIEN=0
+9 FOR
SET RCIEN=$ORDER(^DGCR(399,"APD",RCLDATE,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:2
+10 SET RCFLAG=$$GETECME(RCIEN)
+11 ; No ECME number so not a Pharmacy bill
if RCFLAG=""
QUIT
+12 ;PRCA*4.5*359
SET RCPAYER=$$GET1^DIQ(399,RCIEN_",",101,"E")
IF $PIECE(^DGCR(399,RCIEN,0),U,13)=7!'RCPAYER
QUIT
+13 SET RCINS=$$GET1^DIQ(399,RCIEN_",",101,"I")
+14 ;Dont add if not on approved insurance list
if '$$INSCHK^RCDPENRU(RCINS)
QUIT
+15 DO UPDTMPB(RCLDATE,1,"P",RCIEN,RCSUMFLG,RCPAYER)
End DoDot:2
End DoDot:1
+16 ;
+17 ;Exit
+18 QUIT
+19 ;
+20 ; Get the ECME# from the bill
GETECME(RCIEN) ;
+1 ; Used by:
+2 ; Routine RCDPENR1
+3 ; Routine PRCABJ1
+4 QUIT $$GET1^DIQ(399,RCIEN_",",460,"E")
+5 ;
+6 ;Save a line of data to the Archive file
SAVEDATA(RCDATA,IEN) ;
+1 ;
+2 NEW RCARY,IENS
+3 ;
+4 SET IENS="+1,"_IEN_","
+5 SET RCARY(344.911,IENS,.01)=RCDATA
+6 DO UPDATE^DIE(,"RCARY")
+7 ;
+8 QUIT
+9 ;
+10 ;Initialize the Archive file entry
INITARCH(RPT) ;
+1 ;
+2 NEW FDA,FDAIEN,DT,DT1
+3 ;
+4 SET DT=$$NOW^XLFDT
+5 SET DT1=$EXTRACT(DT,1,5)_"00"
+6 ;
+7 ; set up array
+8 ;Name of report
SET FDA(344.91,"+1,",.01)=RPT
+9 ;Month/year report run
SET FDA(344.91,"+1,",.02)=DT1
+10 ;Status
SET FDA(344.91,"+1,",.03)=1
+11 ;Start date of report
SET FDA(344.91,"+1,",.04)=DT
+12 ;
+13 ;file entry
+14 DO UPDATE^DIE(,"FDA","FDAIEN")
+15 ;
+16 QUIT +$GET(FDAIEN(1))
+17 ;
+18 ;Entry point for reprinting the header.
REPRINT(RCHDR,RCDATA) ;
+1 ;
+2 NEW RCDIVTXT,RCPYRTXT,RCSPACE,RCDATE,RCSTR,RCRUNDT,RCLINE,RCFLG
+3 SET RCLINE=""
SET $PIECE(RCLINE,"-",IOM)=""
+4 ;
+5 ; Store the header into the correct variables
+6 SET RCSPACE=""
+7 SET $PIECE(RCSPACE," ",80)=""
+8 SET RCDIVTXT=$PIECE(RCHDR,U)
+9 SET RCPYRTXT=$PIECE(RCHDR,U,2)
+10 SET RCDATE=$PIECE(RCHDR,U,3)
+11 SET RCRUNDT=$$FMTE^XLFDT($$NOW^XLFDT,2)
+12 ;
+13 ; Call the Header Print routine
+14 DO RPTHDR
+15 ;
+16 ; Reprint the body
+17 SET RCFLG=$$PRINTRP^RCDPENR4("GRAND TOTAL ALL PAYERS",RCDATA,RCDISP)
+18 ;
+19 QUIT
