- RCDPENR2 ;ALB/SAB - EPay National Reports - ERA/EFT Trending Report ; 7/1/19 2:02pm
- ;;4.5;Accounts Receivable;**304,321,326,349,432**;Mar 20, 1995;Build 16
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;Read ^DGCR(399) via Private IA 3820
- ;Read ^DG(40.8) via Controlled IA 417
- ;Read ^IBM(361.1) via Private IA 4051
- ;Use DIV^IBJDF2 via Private IA 3130
- ;Use DIVISION^VAUTOMA via Controlled IA 664
- ;
- Q
- ;
- EFTERA() ; EFT/ERA TRENDING REPORT
- ;
- N DIRUT,DIROUT,DTOUT,DUOUT,X,Y,POP
- N RCBGDT,RCDATA,RCDATE,RCDISP,RCENDDT,RCPYRLST,RCSDT,RCEDT,RCRQDIV,RCRPT
- N RCCLM,RCDIV,RCEXCEL,RCEX,RCPAR,RCPAY,RCPAYR,RCTIN,RCTINR,RCTYPE,RCWHICH
- ;
- ; Alert software to display to screen
- S RCDISP=1
- ;
- ; Ask for Division
- S RCRQDIV=$$GETDIV^RCDPENR4(.RCDIV)
- Q:RCRQDIV=-1
- ;
- S RCAUTO=$$ASKAUTO^RCDPEU1() Q:RCAUTO=-1 ; PRCA*4.5*349
- ;
- S RCTYPE=$$RTYPE^RCDPEU1() Q:RCTYPE=-1
- S RCWHICH=$$NMORTIN^RCDPEAPP() Q:RCWHICH=-1
- ;
- S RCPAR("SELC")=$$PAYRNG^RCDPEU1(0,1,RCWHICH)
- Q:RCPAR("SELC")=-1
- S RCPAY=RCPAR("SELC")
- ;
- I RCPAR("SELC")'="A" D Q:XX=-1
- . S RCPAR("TYPE")=RCTYPE
- . S RCPAR("SRCH")=$S(RCWHICH=2:"T",1:"N")
- . S RCPAR("FILE")=344.4
- . S RCPAR("DICA")="Select Insurance Company"_$S(RCWHICH=1:" NAME: ",1:" TIN: ")
- . S XX=$$SELPAY^RCDPEU1(.RCPAR)
- ;
- ; Ask the user for rate type
- S RCRATE=$$GETRATE()
- Q:RCRATE=-1
- ;
- ; PRCA*4.5*349 - Add Closed Claims filter
- S RCCLM=$$CLOSEDC^RCDPEU1()
- Q:RCCLM=-1
- ;
- ; Ask the user for report type, with a prompt for the main report.
- S RCRPT=$$GETRPT(1)
- Q:RCRPT=-1
- ;
- ; Retrieve start date
- S RCBGDT=$$GETSDATE()
- Q:RCBGDT=-1
- ;
- ; Retrieve end date. Send user start date as the lower bound.
- S RCENDDT=$$GETEDATE(RCBGDT)
- Q:RCENDDT=-1
- ;
- ;If the user is running the main report, ask if they wish to export to Excel
- S RCEXCEL=0
- S:RCRPT="M" RCEXCEL=$$DISPTY^RCDPRU()
- D:RCEXCEL INFO^RCDPRU
- I 'RCEXCEL,(RCRPT="M") W !!,"This report requires 132 columns.",!!
- D AUTO(1,RCBGDT,RCENDDT,.RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,.RCDIV,RCAUTO)
- Q
- ;
- AUTO(RCDISP,RCBGDT,RCENDDT,RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,RCDIV,RCAUTO) ;
- ; Inputs: RCAUTO (Optional) - A - Auto-Post, N-Non-Auto-Post, B-Both (Defaults to B)
- ; 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
- ; RCRPT - (M)ain, (S)ummary or (G)rand Total Report
- ; RCEXCEL - Flag to indicate output in "^" delimited format
- ; RCRATE - Billing Rate Type flag
- ; RCDIV - Divisions to report on.
- ; RCPAY - Payers to report on (All, range, or single payer)
- ; RCTYPE - Types of payers to include (M - Medical, P - Pharmacy, T - Tricare C - CHAMPVA)
- ; RCWHICH - select payers by name or TIN (1 - Name, 2 - TIN)
- ;
- ;Select output device
- W !
- I $G(RCAUTO)="" S RCAUTO="B" ; PRCA*4.5*349
- I $G(RCCLM)="" S RCCLM="A" ; PRCA*4.5*349
- I $G(RCPAY)="" S RCPAY="A" ; PRCA*4.5*349
- I $G(RCTYPE)="" S RCTYPE="A" ; PRCA*4.5*349
- I $G(RCWHICH)="" S RCWHICH=2 ; PRCA*4.5*349
- 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^RCDPENR2"
- .S ZTDESC="EFT/ERA Trending Report"
- .S ZTSAVE("RC*")=""
- .S ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
- .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,RCPHARM,RCPYALL,RCTINALL
- ;
- ;Note: RCPYALL an RCTINALL are used in tag HEADER to determine header output.
- ;
- ; Clear temp arrays
- K ^TMP("RCDPEADP",$J),^TMP("RCDPENR2",$J)
- ;
- ; Compile list of divisions
- D DIV^RCDPENR4(.RCDIV)
- ;
- ; Gather raw data
- ; PRCA*4.5*349 - Add Closed Claims filter
- D GETEFT^RCDPENR3(RCBGDT,RCENDDT,RCRATE,RCCLM)
- D GETERA^RCDPENR4(RCBGDT,RCENDDT,RCRATE,RCCLM)
- ;
- ;Check for data captures
- I '$D(^TMP("RCDPENR2",$J,"MAIN")) D Q
- . W !!,"There was no data available for the requested report. Please try again."
- ;
- ;Generate the statistics if any data captured
- D COMPILE^RCDPENR3
- ;
- ; Print out the results
- D PRINT(RCRPT)
- ;
- ;Clean up temp array afterwards
- K ^TMP("RCDPENR2",$J)
- K ^TMP("RCDPEU1",$J)
- Q
- ;
- ;Print the results.
- PRINT(RCSUMFLG) ;Print the results
- ;
- ; Temp Array format
- ; ^TMP("RCDPENR1",$J,"TOT")=# Medical 835's ^ # Pharmacy 835's ^
- N RCSTOP,RCPAGE,RCLINE,RCRUNDT,RCRPIEN,RCSUBJ,RCXMZ,SECTION
- ;
- ;set separator print line.
- S RCLINE="",$P(RCLINE,"-",IOM)=""
- S SECTION=RCSUMFLG
- ;
- ; 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^RCDPENR1("EFT/ERA TRENDING")
- ;
- ; Display Header
- D HEADER
- ;
- ; Display the Main Level report
- I RCSUMFLG="M" D
- . S RCSTOP=$$MAIN()
- Q:RCSTOP
- ;
- S SECTION="S"
- I +$G(RCEXCEL)=0,RCSUMFLG="M" D
- . D ASK^RCDPEADP(.RCSTOP,0)
- . Q:RCSTOP
- . D HEADER
- I RCSTOP Q
- ;
- ; Display the Payer/TIN summary information
- I RCSUMFLG="S" S RCSTOP=$$SUMMARY()
- Q:RCSTOP
- ;
- ; Display the grand total at the end
- S SECTION="G"
- S RCSTOP=$$GRAND()
- Q:RCSTOP
- ;
- ; If not displaying to screen, send
- I 'RCDISP D
- . S RCSUBJ="ERA/EFT TRENDING REPORT"
- . S RCXMZ=$$XM^RCDPENRU(RCRPIEN,RCBGDT,RCENDDT,RCSUBJ)
- ;
- ;Report finished
- I $Y>(IOSL-4),RCDISP D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER
- I RCDISP,'$G(RCEXCEL) W !,$$ENDORPRT^RCDPEARL
- W !
- ;
- ;Close device
- I '$D(ZTQUEUED) D ^%ZISC
- I $D(ZTQUEUED) S ZTREQ="@"
- Q
- ;
- ;
- ; Undeclared Parameters - RCDISP and RCRPIEN
- ;
- N RCAUTOT,RCDIVTXT,RCPYRTXT,RCSTR,RCTYPTXT,RCCLMTXT
- ;
- S RCDIVTXT=$$DIVTXT^RCDPENR1()
- S RCPYRTXT=$S(RCPAY="S":"SELECTED",RCPAY="R":"RANGE",1:"ALL")_" "
- S RCPYRTXT=RCPYRTXT_$S(RCWHICH=2:"TINS",1:"PAYERS")
- S RCTYPTXT=$S('+$G(RCEXCEL):"MEDICAL/PHARMACY/TRICARE/CHAMPVA: ",1:"")
- S RCTYPTXT=RCTYPTXT_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL") ;PRCA*4.5*432 Add CHAMPVA
- S RCAUTOT="MANUAL/AUTOPOST: "_$S(RCAUTO="N":"MANUAL",RCAUTO="A":"AUTOPOST",1:"BOTH")
- S RCCLMTXT="Claims: "_$S(RCCLM="C":"CLOSED",1:"ALL") ; PRCA*4.5*349
- ;
- S RCPAGE=RCPAGE+1
- I '+RCDISP D Q
- . S RCSTR="EFT/ERA TRENDING REPORT^PAGE "_$J(RCPAGE,5)
- . D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
- . S RCSTR="^"_RCDIVTXT_"^"_RCPYRTXT_"^"_RCTYPTXT
- . D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
- . S RCSTR="^"_"DATE RANGE: "_$$FMTE^XLFDT(RCBGDT,2)_" - "_$$FMTE^XLFDT(RCENDDT,2)_"^"_"RUN DATE: "_RCRUNDT
- . D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
- . D SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
- W @IOF,"EFT/ERA TRENDING REPORT"
- I '$G(RCEXCEL) D ;
- . W ?122,"PAGE ",$J(RCPAGE,5),!
- . W " "_$E(RCDIVTXT,1,23),?25,$E(RCPYRTXT,1,20),?46,$E(RCTYPTXT,1,43) ;PRCA*4.5*432 35 -> 43
- . W ?90,RCAUTOT,?118,RCCLMTXT,! ;PRCA*4.5*432 80 -> 90, 108 -> 118
- . W ?5,"DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
- . W ?51,"RUN DATE: ",RCRUNDT,!
- . W RCLINE,!
- I +$G(RCEXCEL) D
- . W "^PAGE ",$J(RCPAGE,5)
- . W "^",RCDIVTXT,"^",RCPYRTXT,"^",RCTYPTXT
- . W "^","DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
- . W "^","RUN DATE: ",RCRUNDT
- . W "^",RCAUTOT,"^",RCCLMTXT,!
- ;
- ; Re-display the column headers
- I '$G(RCEXCEL),(SECTION="M") D COLHEAD
- I $G(RCEXCEL),(RCPAGE=1) D COLHEAD
- Q
- ;
- ;Print the Detailed portion of the report
- MAIN() ;
- ;
- N RCERATYP,RCDATA,RCERATXT,RCSTRING,RCEFTTXT,RCEFT,RCERA,RCINSTIN,RCCLAIM,RCBILL
- N RCAMTBL,RCPAID,RCBILLDT,RCERADT,RCEFTDT,RCPOSTDT,RCTRACE,RCATPST,RCIDX,RCAMTPD
- N RCETRAN,RCERA,RCEOB,RCEFTNO,RCBEDY,RCEEDY,RCEPDY,RCBPDY,RCMETHOD,RCTOTDY,RCTMP,RCSTOP,RCIDX
- ;
- ; Print ERA/EFT combinations for each Insurance Company/Tin combination
- S RCINSTIN="",RCSTOP=0
- F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN)) Q:RCINSTIN="" D Q:RCSTOP
- . S RCMETHOD=""
- . F S RCMETHOD=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD)) Q:RCMETHOD="" D Q:RCSTOP
- . . I (RCAUTO="A"&(RCMETHOD="MANUAL"))!(RCAUTO="N"&(RCMETHOD="AUTOPOST")) Q ; PRCA*4.5*349
- . . S RCSTOP=$$PRINTINS(RCINSTIN) ; PRCA*4.5*349 add "." to this and every subsequent line
- . . Q:RCSTOP
- . . F I=1:1:3 D Q:RCSTOP
- . . . I RCMETHOD="AUTOPOST",I>1 Q ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
- . . . S RCERATYP=$S(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
- . . . S RCEFTTXT=$P(RCERATYP,"/")
- . . . S RCERATXT=$P(RCERATYP,"/",2)
- . . . S RCEFT=$S(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
- . . . S RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_RCMETHOD ; PRCA*4.5*349
- . . . S RCSTOP=$$PRINTHDR(RCSTRING)
- . . . Q:RCSTOP
- . . . I '$G(RCEXCEL),$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,I,""))="" D ; PRCA*4.5*349
- . . . . W "No data captured for this section during the specified time period.",! ; PRCA*4.5*349
- . . . S RCCLAIM=""
- . . . F S RCCLAIM=$O(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM)) Q:RCCLAIM="" D Q:RCSTOP
- . . . . I $Y>(IOSL-5) D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER
- . . . . S RCDATA=$G(^TMP("RCDPENR2",$J,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM))
- . . . . I RCDATA="" D Q
- . . . . . W !,"No data captured for this section during the specified time period.",!
- . . . . ;
- . . . . ;Init display values for the days
- . . . . S (RCBEDY,RCEEDY,RCEPDY,RCBPDY)=""
- . . . . S RCBILL=$$GET1^DIQ(399,+RCCLAIM_",",".01","E")
- . . . . I $P(RCDATA,U,9),$P(RCDATA,U,8) S RCBEDY=$$FMTH^XLFDT($P(RCDATA,U,9),1)-$$FMTH^XLFDT($P(RCDATA,U,8),1)
- . . . . I $P(RCDATA,U,10),$P(RCDATA,U,9) S RCEEDY=$$FMTH^XLFDT($P(RCDATA,U,10),1)-$$FMTH^XLFDT($P(RCDATA,U,9),1)
- . . . . S RCIDX=$S($$FMTH^XLFDT($P(RCDATA,U,10),1)>$$FMTH^XLFDT($P(RCDATA,U,10),1):10,1:9) ; Find the latest date between ERA and EFT
- . . . . I $P(RCDATA,U,11),$P(RCDATA,U,RCIDX) S RCEPDY=$$FMTH^XLFDT($P(RCDATA,U,11),1)-$$FMTH^XLFDT($P(RCDATA,U,RCIDX),1) ; Use latest date to determ days btw ERA/EFT and Posting
- . . . . I $P(RCDATA,U,11),$P(RCDATA,U,8) S RCBPDY=$$FMTH^XLFDT($P(RCDATA,U,11),1)-$$FMTH^XLFDT($P(RCDATA,U,8),1)
- . . . . I RCEXCEL D
- . . . . . S RCTMP=RCBILL_"^"_$$FMTE^XLFDT($P(RCDATA,U,5),2)_"^"_$P(RCDATA,U,6)_"^"_$P(RCDATA,U,7)_"^"_$$FMTE^XLFDT($P(RCDATA,U,8),2)
- . . . . . S RCTMP=RCTMP_"^"_$$FMTE^XLFDT($P(RCDATA,U,9),2)_"^"_$$FMTE^XLFDT($P(RCDATA,U,10),2)_"^"_$$FMTE^XLFDT($P(RCDATA,U,11),2)_"^"_$P(RCDATA,U,12)_"^"_$P(RCDATA,U,13)
- . . . . . S RCTMP=RCTMP_"^"_$P(RCDATA,U,14)_"^"_$P(RCDATA,U,2)_"^"_$P(RCDATA,U,15)_"^"_$P(RCDATA,U,3)_"^"
- . . . . . S RCTMP=RCTMP_RCBEDY_"^"_RCEEDY_"^"_RCEPDY_"^"_RCBPDY
- . . . . . W RCTMP,!
- . . . . I 'RCEXCEL D
- . . . . . W RCBILL,?21,$$FMTE^XLFDT($P(RCDATA,U,5),2),?30,$J($P(RCDATA,U,6),10,2),?41,$J($P(RCDATA,U,7),10,2),?52,$$FMTE^XLFDT($P(RCDATA,U,8),2)
- . . . . . W ?61,$$FMTE^XLFDT($P(RCDATA,U,9),2),?75,$$FMTE^XLFDT($P(RCDATA,U,10),2),?89,$$FMTE^XLFDT($P(RCDATA,U,11),2),?98,$P(RCDATA,U,12),?109,$P(RCDATA,U,13),!
- . . . . . W ?5,$P(RCDATA,U,14),?17,$P(RCDATA,U,2),?28,$J($P(RCDATA,U,15),6),?39,$P(RCDATA,U,3),?50,$J(RCBEDY,8)
- . . . . . W ?67,$J(RCEEDY,8),?83,$J(RCEPDY,8),?106,$J(RCBPDY,8),!
- . . . I '$G(RCEXCEL) W RCLINE,!
- ;
- I RCSTOP Q RCSTOP
- ; Section break - ask user if they wish to continue...
- ;
- Q RCSTOP
- ;
- SUMMARY() ;Print the Payer Summary portion of the report
- ;
- I $G(RCEXCEL) Q 0
- N RCSTOP ; PRCA*4.5*349
- ;
- ; Print ERA/EFT combinations for each Insurance Company/Tin combination
- S RCINSTIN="",RCSTOP=0
- F S RCINSTIN=$O(^TMP("RCDPENR2",$J,"PAYER",RCINSTIN)) Q:RCINSTIN="" D Q:RCSTOP
- . D PAYSUM^RCDPENR4(RCINSTIN)
- Q RCSTOP
- ;
- ;Total for all payers in report
- GRAND() ;
- I $G(RCEXCEL) Q 0
- ;
- N I,J,RCDATA,RCEFT,RCERA,RCERAFLG,RCEFTTXT,RCERATXT,RCERATYP,RCSTRING,RCSTOP ; PRCA*4.5*349
- ;
- S RCSTOP=0
- ; Print the Grand Total Banner
- I $Y>(IOSL-7),RCDISP D ASK^RCDPEADP(.RCSTOP,0) Q:RCSTOP D HEADER
- I RCSUMFLG'="G",RCDISP D
- . W !,"GRAND TOTALS ALL PAYERS",!!
- . W RCLINE,!
- ;
- ; Print all 3 EOB/Payment combinations
- F J="AUTOPOST","MANUAL","TOTAL" Q:RCSTOP F I=1:1:3 D Q:RCSTOP ; PRCA*4.5*349
- . I J="AUTOPOST",I>1 Q ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
- . I (RCAUTO="A"&(J="MANUAL"))!(RCAUTO="N"&(J="AUTOPOST"))!(RCAUTO'="B"&(J="TOTAL")) Q ; PRCA*4.5*349
- . S RCDATA=$G(^TMP("RCDPENR2",$J,"GTOT",J,I)) ; PRCA*4.5*349
- . S RCERATYP=$S(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
- . S RCERAFLG=0
- . S RCEFTTXT=$P(RCERATYP,"/")
- . S RCERATXT=$P(RCERATYP,"/",2)
- . S RCEFT=$S(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
- . S RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_J ; PRCA*4.5*349
- . I (RCEFTTXT="EFT"),(RCERATXT["ERA") S RCERAFLG=1
- . D PRINTGT^RCDPENR3(RCSTRING,RCDATA,RCDISP,RCERAFLG,RCEXCEL)
- ;
- Q RCSTOP
- ;
- PRINTINS(RCINS) ; Print the insurance header line
- ; Input: RCINS - Payer Name/TIN to be displayed
- ; RCLINE - line of dashes used for separation
- ; Returns 1 - User quit out of report, 0 otherwise
- I $G(RCEXCEL) Q 0
- N RCSTOP,XX,YY,ZZ
- ;
- S RCSTOP=0
- I $Y>(IOSL-7) D
- . D ASK^RCDPEADP(.RCSTOP,0)
- . Q:RCSTOP
- . D HEADER
- I RCSTOP Q RCSTOP
- W "PAYER NAME/TIN",!
- W " ",$$PAYTIN^RCDPRU2(RCINS,78),!
- W RCLINE,!
- Q RCSTOP
- ;
- ;Print the Payment Method header lines
- PRINTHDR(RCTITLE) ;
- ; Undeclared parameters
- ; RCLINE - line of "-" for report formating
- ; RCSUMFLG - Type of report (M=Main,S=Summary,G=Grand Total)
- ; RCDISP - Is the report being email (0) or Printed (1)
- ; RCRPIEN - IEN to store the report if emailing
- ;
- I $G(RCEXCEL) Q 0
- N RCBORDER,RCSTOP,RCSTR
- ;
- S RCBORDER="",$P(RCBORDER,"*",20)="",RCSTOP=0
- I $Y>(IOSL-7),RCDISP D
- . D ASK^RCDPEADP(.RCSTOP,0)
- . Q:RCSTOP
- . D HEADER
- I RCSTOP Q RCSTOP
- ;
- ; Display report type being displayed
- I 'RCDISP D Q
- . S RCSTR=RCBORDER_" "_RCTITLE_" "_RCBORDER
- . D SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
- . D SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
- I RCDISP D
- . W RCBORDER," ",RCTITLE," ",RCBORDER,!
- . W RCLINE,!
- ;
- Q RCSTOP
- ;
- GETDIV(RCDIV) ; Retrieve the Division
- ; PRCA*4.5*349 - Moved to RCDPENR4 for size
- Q $$GETDIV^RCDPENR4(.RCDIV)
- ;
- ;Retrieve the Report Type
- GETRATE() ;
- ;
- ;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
- N X,Y,DIC,DTOUT,DUOUT
- ;
- S DIC="^DGCR(399.3,",DIC(0)="AEQMN"
- S DIC("S")="I $P(^(0),U,7)=""i"""
- D ^DIC K DIC
- Q +Y
- ;
- ;Retrieve the Report Type
- GETRPT(RCMNFLG) ;
- ;
- ;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
- N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
- ;
- ; Prompt with Main (EFT/ERA Trending report (from RCDPENR2))
- I $G(RCMNFLG) D
- . S DIR("A")="Print (M)AIN Report, (S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
- . S DIR(0)="SA^M:MAIN;S:SUMMARY;G:GRAND TOTAL"
- ;
- ; Prompt w/o main (Volume Statistics report (from RCDPENR1))
- I '$G(RCMNFLG) D
- . S DIR("A")="(S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
- . S DIR(0)="SA^S:SUMMARY;G:GRAND TOTAL"
- ;
- S DIR("?")="Select the type of report to Generate."
- S DIR("B")="G"
- D ^DIR K DIR
- I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
- Q Y
- ;
- ;
- GETSDATE() ;
- N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCTODAY
- ;
- ;Assume the start date is 45 days prior to the end date
- ;
- ;Get the start date.
- S RCTODAY=$P($$NOW^XLFDT,".")
- S DIR("?")="ENTER THE EARLIEST DATE TO INCLUDE ON THE REPORT"
- S DIR(0)="DA^:"_RCTODAY_":APE",DIR("A")="Start with DATE: "
- D ^DIR K DIR
- I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
- Q Y
- ;
- ; Retrieve the end date of the report from the user.
- GETEDATE(RCBDATE) ;
- ; RCBDATE - Begin date of the report. Used as a lower bound
- ;
- N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCTODAY
- ;
- ; Get the End date first. Assume the end date is today.
- S RCTODAY=$P($$NOW^XLFDT,".")
- S DIR("?")="ENTER THE LATEST DATE TO INCLUDE ON THE REPORT"
- S DIR("B")=$$FMTE^XLFDT(RCTODAY,2)
- S DIR(0)="DAO^"_$G(RCBDATE)_":"_RCTODAY_":APE",DIR("A")="Go to DATE: " D ^DIR K DIR
- I $D(DTOUT)!$D(DUOUT)!(Y="") Q -1
- Q Y
- ;
- GETARPYR(RCTIN,RCPAY) ; Retrieve the Payer IEN from the RCDPE AUTO-PAY EXCLUSION file (#344.6)
- ; Input: RCTIN - Payer ID
- ; RCPAY - Payer Name (optional)
- ; Return: Payer IEN (#344.6)
- ;
- N RCIEN,QUIT,ZZ
- S RCPAY=$G(RCPAY)
- ;
- ; Send the IEN entry in the file if the Payer is in it. Otherwise, send 0.
- S RCIEN=0
- ;
- ; PRCA*4.5*321 - Add optional payer name to search to narrow down payer
- I RCPAY'="" D ;
- . S ZZ="",QUIT=0
- . F S ZZ=$O(^RCY(344.6,"C",RCTIN_" ",ZZ)) Q:ZZ="" D I RCIEN Q ;
- . . I $$GET1^DIQ(344.6,ZZ_",",.01,"E")=RCPAY S RCIEN=ZZ
- ;
- I 'RCIEN D ;
- . S RCIEN=$O(^RCY(344.6,"C",RCTIN_" ",""))
- ;
- Q +RCIEN
- ;
- ; Determine if the payer in the ERA or EFT should be included in the report.
- INSCHK(RCINS) ;
- ;
- ;Send yes if all payers are being reported on.
- Q:$D(^TMP("RCDPENR2",$J,"INS","A")) 1
- ;
- ; Send yes if Payer is in the list to report on
- Q:$D(^TMP("RCDPENR2",$J,"INS",RCINS)) 1
- ;
- ; Otherwise, send no
- Q 0
- ;
- DIV(RCDIV) ; build the list of divisions to report on.
- ; PRCA*4.5*349 - Moved to RCDPENR4 for size
- D DIV^RCDPENR4(.RCDIV)
- Q
- ;Determine the text to display for the Payer TINs
- TINTXT() ;
- ;
- N RCTIN,RCTXT,RCTNTXT
- ;
- Q:$D(^TMP("RCDPEADP",$J,"TIN","A")) "ALL PAYER TINS"
- ;
- ;Build list of Payer Tins
- ;
- S RCTIN="",RCTXT=""
- F S RCTIN=$O(^TMP("RCDPEADP",$J,"TIN",RCTIN)) Q:RCTIN="" D
- . S RCTNTXT=$$GET1^DIQ(344.6,+RCTIN_",",".02","I")
- . S RCTXT=RCTXT_RCTNTXT_","
- ;
- ; 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)
- ;
- COLHEAD ;
- ;
- N RCTMP
- ;
- ;Display the column headers
- I RCEXCEL D
- . S RCTMP="CLAIM#^DOS^AMT BILLED^AMT PAID^BILLED^ERA/EOB REC'D^EFT/PMT REC'D^POSTED^TRACE #^AUTOPOST/MANUAL"
- . S RCTMP=RCTMP_"^ETRANS TYPE^ERA#^#EEOBS^EFT#^#DAYS:(BILL/ERA)^#DAYS:(ERA/EFT)^#DAYS:(ERA+EFT/POSTED)^"
- . S RCTMP=RCTMP_"TOTAL #DAYS(BILL/POSTED)"
- . W RCTMP,!
- I 'RCEXCEL D
- . W "CLAIM#",?21,"DOS",?30,"AMT BILLED",?41,"AMT PAID",?52,"BILLED",?61,"ERA/EOB REC'D",?75,"EFT/PMT REC'D",?89,"POSTED",?98,"TRACE #",?109,"AUTOPOST/MANUAL",!
- . W ?5,"ETRANS TYPE",?17,"ERA#",?28,"#EEOBS",?39,"EFT#",?50,"#DAYS:(BILL/ERA)",?67,"#DAYS:(ERA/EFT)",?83,"#DAYS:(ERA+EFT/POSTED)",?106,"TOTAL #DAYS(BILL/POSTED)",!
- . W RCLINE,!
- Q
- ;
- ;Entry point for reprinting the header.
- REPRINT(RCIEN) ;
- ;
- N I,RCDATA,J,RCSTOP,PAGE
- ;
- ;
- S PAGE=1
- D RPTHDR(RCIEN,PAGE)
- ;
- S I=4,RCSTOP=0 ;loop through the main body
- F S I=$O(^RCDM(344.91,RCIEN,1,I)) Q:'I D Q:RCSTOP
- . S RCDATA=$G(^RCDM(344.91,RCIEN,1,I,0))
- . ;
- . I $Y>(IOSL-4) D Q:RCSTOP
- . . D ASK^RCDPEADP(.RCSTOP,0)
- . . Q:RCSTOP
- . . S PAGE=PAGE+1
- . . D RPTHDR(RCIEN,PAGE)
- . ; main body of report
- . W $P(RCDATA,U)
- . I RCDATA["^" W ?65,$P(RCDATA,U,2)
- . W ! ;Add <CRLF>
- Q
- ;
- RPTHDR(RCIEN,PAGE) ; Reprint the header
- ;
- N I,RCDATA
- ;
- W @IOF ; Create new page
- ;
- F I=1:1:4 D
- . S RCDATA=$G(^RCDM(344.91,RCIEN,1,I,0))
- . ; header lines formatting
- . I I=1 W ?15,$P(RCDATA,U),?70,PAGE,! Q
- . I I=2 W ?5,$P(RCDATA,U,2),! Q
- . I I=3!(I=4) W ?5,$P(RCDATA,U,2),?45,$P(RCDATA,U,3),! Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPENR2 19680 printed Feb 18, 2025@23:11:26 Page 2
- RCDPENR2 ;ALB/SAB - EPay National Reports - ERA/EFT Trending Report ; 7/1/19 2:02pm
- +1 ;;4.5;Accounts Receivable;**304,321,326,349,432**;Mar 20, 1995;Build 16
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;Read ^DGCR(399) via Private IA 3820
- +5 ;Read ^DG(40.8) via Controlled IA 417
- +6 ;Read ^IBM(361.1) via Private IA 4051
- +7 ;Use DIV^IBJDF2 via Private IA 3130
- +8 ;Use DIVISION^VAUTOMA via Controlled IA 664
- +9 ;
- +10 QUIT
- +11 ;
- EFTERA() ; EFT/ERA TRENDING REPORT
- +1 ;
- +2 NEW DIRUT,DIROUT,DTOUT,DUOUT,X,Y,POP
- +3 NEW RCBGDT,RCDATA,RCDATE,RCDISP,RCENDDT,RCPYRLST,RCSDT,RCEDT,RCRQDIV,RCRPT
- +4 NEW RCCLM,RCDIV,RCEXCEL,RCEX,RCPAR,RCPAY,RCPAYR,RCTIN,RCTINR,RCTYPE,RCWHICH
- +5 ;
- +6 ; Alert software to display to screen
- +7 SET RCDISP=1
- +8 ;
- +9 ; Ask for Division
- +10 SET RCRQDIV=$$GETDIV^RCDPENR4(.RCDIV)
- +11 if RCRQDIV=-1
- QUIT
- +12 ;
- +13 ; PRCA*4.5*349
- SET RCAUTO=$$ASKAUTO^RCDPEU1()
- if RCAUTO=-1
- QUIT
- +14 ;
- +15 SET RCTYPE=$$RTYPE^RCDPEU1()
- if RCTYPE=-1
- QUIT
- +16 SET RCWHICH=$$NMORTIN^RCDPEAPP()
- if RCWHICH=-1
- QUIT
- +17 ;
- +18 SET RCPAR("SELC")=$$PAYRNG^RCDPEU1(0,1,RCWHICH)
- +19 if RCPAR("SELC")=-1
- QUIT
- +20 SET RCPAY=RCPAR("SELC")
- +21 ;
- +22 IF RCPAR("SELC")'="A"
- Begin DoDot:1
- +23 SET RCPAR("TYPE")=RCTYPE
- +24 SET RCPAR("SRCH")=$SELECT(RCWHICH=2:"T",1:"N")
- +25 SET RCPAR("FILE")=344.4
- +26 SET RCPAR("DICA")="Select Insurance Company"_$SELECT(RCWHICH=1:" NAME: ",1:" TIN: ")
- +27 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
- End DoDot:1
- if XX=-1
- QUIT
- +28 ;
- +29 ; Ask the user for rate type
- +30 SET RCRATE=$$GETRATE()
- +31 if RCRATE=-1
- QUIT
- +32 ;
- +33 ; PRCA*4.5*349 - Add Closed Claims filter
- +34 SET RCCLM=$$CLOSEDC^RCDPEU1()
- +35 if RCCLM=-1
- QUIT
- +36 ;
- +37 ; Ask the user for report type, with a prompt for the main report.
- +38 SET RCRPT=$$GETRPT(1)
- +39 if RCRPT=-1
- QUIT
- +40 ;
- +41 ; Retrieve start date
- +42 SET RCBGDT=$$GETSDATE()
- +43 if RCBGDT=-1
- QUIT
- +44 ;
- +45 ; Retrieve end date. Send user start date as the lower bound.
- +46 SET RCENDDT=$$GETEDATE(RCBGDT)
- +47 if RCENDDT=-1
- QUIT
- +48 ;
- +49 ;If the user is running the main report, ask if they wish to export to Excel
- +50 SET RCEXCEL=0
- +51 if RCRPT="M"
- SET RCEXCEL=$$DISPTY^RCDPRU()
- +52 if RCEXCEL
- DO INFO^RCDPRU
- +53 IF 'RCEXCEL
- IF (RCRPT="M")
- WRITE !!,"This report requires 132 columns.",!!
- +54 DO AUTO(1,RCBGDT,RCENDDT,.RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,.RCDIV,RCAUTO)
- +55 QUIT
- +56 ;
- AUTO(RCDISP,RCBGDT,RCENDDT,RCPYRLST,RCRQDIV,RCRPT,RCEXCEL,RCRATE,RCDIV,RCAUTO) ;
- +1 ; Inputs: RCAUTO (Optional) - A - Auto-Post, N-Non-Auto-Post, B-Both (Defaults to B)
- +2 ; RCDISP - Display results to screen or archive file flag
- +3 ; RCBGDT - begin date of the report
- +4 ; RCENDDT - End date of the report
- +5 ; RCPYRLST - Payers to report on (All, range, or single payer)
- +6 ; RCRQDIV - Division to report on - (A)ll or a single division
- +7 ; RCRPT - (M)ain, (S)ummary or (G)rand Total Report
- +8 ; RCEXCEL - Flag to indicate output in "^" delimited format
- +9 ; RCRATE - Billing Rate Type flag
- +10 ; RCDIV - Divisions to report on.
- +11 ; RCPAY - Payers to report on (All, range, or single payer)
- +12 ; RCTYPE - Types of payers to include (M - Medical, P - Pharmacy, T - Tricare C - CHAMPVA)
- +13 ; RCWHICH - select payers by name or TIN (1 - Name, 2 - TIN)
- +14 ;
- +15 ;Select output device
- +16 WRITE !
- +17 ; PRCA*4.5*349
- IF $GET(RCAUTO)=""
- SET RCAUTO="B"
- +18 ; PRCA*4.5*349
- IF $GET(RCCLM)=""
- SET RCCLM="A"
- +19 ; PRCA*4.5*349
- IF $GET(RCPAY)=""
- SET RCPAY="A"
- +20 ; PRCA*4.5*349
- IF $GET(RCTYPE)=""
- SET RCTYPE="A"
- +21 ; PRCA*4.5*349
- IF $GET(RCWHICH)=""
- SET RCWHICH=2
- +22 IF RCDISP
- SET %ZIS="QM"
- DO ^%ZIS
- if POP
- QUIT
- +23 ;Option to queue
- +24 IF 'RCDISP
- IF $DATA(IO("Q"))
- Begin DoDot:1
- +25 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
- +26 SET ZTRTN="REPORT^RCDPENR2"
- +27 SET ZTDESC="EFT/ERA Trending Report"
- +28 SET ZTSAVE("RC*")=""
- +29 SET ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
- +30 DO ^%ZTLOAD
- +31 IF $DATA(ZTSK)
- WRITE !!,"Task number "_ZTSK_" has been queued."
- +32 IF '$TEST
- WRITE !!,"Unable to queue this job."
- +33 KILL ZTSK,IO("Q")
- DO HOME^%ZIS
- End DoDot:1
- QUIT
- +34 ;
- +35 ;Compile and Print Report
- +36 DO REPORT
- +37 QUIT
- +38 ;
- REPORT ; Trace the ERA file for the given date range
- +1 ;
- +2 NEW RCPYRS,RCINS,RCDATA,RCDTLDT,RCDTLIEN,RCIEN,RCEOB,RCBILLNO,RCBATCH,RCPHARM,RCPYALL,RCTINALL
- +3 ;
- +4 ;Note: RCPYALL an RCTINALL are used in tag HEADER to determine header output.
- +5 ;
- +6 ; Clear temp arrays
- +7 KILL ^TMP("RCDPEADP",$JOB),^TMP("RCDPENR2",$JOB)
- +8 ;
- +9 ; Compile list of divisions
- +10 DO DIV^RCDPENR4(.RCDIV)
- +11 ;
- +12 ; Gather raw data
- +13 ; PRCA*4.5*349 - Add Closed Claims filter
- +14 DO GETEFT^RCDPENR3(RCBGDT,RCENDDT,RCRATE,RCCLM)
- +15 DO GETERA^RCDPENR4(RCBGDT,RCENDDT,RCRATE,RCCLM)
- +16 ;
- +17 ;Check for data captures
- +18 IF '$DATA(^TMP("RCDPENR2",$JOB,"MAIN"))
- Begin DoDot:1
- +19 WRITE !!,"There was no data available for the requested report. Please try again."
- End DoDot:1
- QUIT
- +20 ;
- +21 ;Generate the statistics if any data captured
- +22 DO COMPILE^RCDPENR3
- +23 ;
- +24 ; Print out the results
- +25 DO PRINT(RCRPT)
- +26 ;
- +27 ;Clean up temp array afterwards
- +28 KILL ^TMP("RCDPENR2",$JOB)
- +29 KILL ^TMP("RCDPEU1",$JOB)
- +30 QUIT
- +31 ;
- +32 ;Print the results.
- PRINT(RCSUMFLG) ;Print the results
- +1 ;
- +2 ; Temp Array format
- +3 ; ^TMP("RCDPENR1",$J,"TOT")=# Medical 835's ^ # Pharmacy 835's ^
- +4 NEW RCSTOP,RCPAGE,RCLINE,RCRUNDT,RCRPIEN,RCSUBJ,RCXMZ,SECTION
- +5 ;
- +6 ;set separator print line.
- +7 SET RCLINE=""
- SET $PIECE(RCLINE,"-",IOM)=""
- +8 SET SECTION=RCSUMFLG
- +9 ;
- +10 ; Init the stop flag, page count
- +11 SET RCSTOP=0
- SET RCPAGE=0
- +12 ;
- +13 ; Set the Run date for the report
- +14 SET RCRUNDT=$$FMTE^XLFDT($$NOW^XLFDT,2)
- +15 ;
- +16 ; Open the device
- +17 IF RCDISP
- USE IO
- +18 ;
- +19 IF 'RCDISP
- Begin DoDot:1
- +20 SET RCRPIEN=$$INITARCH^RCDPENR1("EFT/ERA TRENDING")
- End DoDot:1
- if 'RCRPIEN
- QUIT
- +21 ;
- +22 ; Display Header
- +23 DO HEADER
- +24 ;
- +25 ; Display the Main Level report
- +26 IF RCSUMFLG="M"
- Begin DoDot:1
- +27 SET RCSTOP=$$MAIN()
- End DoDot:1
- +28 if RCSTOP
- QUIT
- +29 ;
- +30 SET SECTION="S"
- +31 IF +$GET(RCEXCEL)=0
- IF RCSUMFLG="M"
- Begin DoDot:1
- +32 DO ASK^RCDPEADP(.RCSTOP,0)
- +33 if RCSTOP
- QUIT
- +34 DO HEADER
- End DoDot:1
- +35 IF RCSTOP
- QUIT
- +36 ;
- +37 ; Display the Payer/TIN summary information
- +38 IF RCSUMFLG="S"
- SET RCSTOP=$$SUMMARY()
- +39 if RCSTOP
- QUIT
- +40 ;
- +41 ; Display the grand total at the end
- +42 SET SECTION="G"
- +43 SET RCSTOP=$$GRAND()
- +44 if RCSTOP
- QUIT
- +45 ;
- +46 ; If not displaying to screen, send
- +47 IF 'RCDISP
- Begin DoDot:1
- +48 SET RCSUBJ="ERA/EFT TRENDING REPORT"
- +49 SET RCXMZ=$$XM^RCDPENRU(RCRPIEN,RCBGDT,RCENDDT,RCSUBJ)
- End DoDot:1
- +50 ;
- +51 ;Report finished
- +52 IF $Y>(IOSL-4)
- IF RCDISP
- DO ASK^RCDPEADP(.RCSTOP,0)
- if RCSTOP
- QUIT
- DO HEADER
- +53 IF RCDISP
- IF '$GET(RCEXCEL)
- WRITE !,$$ENDORPRT^RCDPEARL
- +54 WRITE !
- +55 ;
- +56 ;Close device
- +57 IF '$DATA(ZTQUEUED)
- DO ^%ZISC
- +58 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +59 QUIT
- +60 ;
- +1 ;
- +2 ; Undeclared Parameters - RCDISP and RCRPIEN
- +3 ;
- +4 NEW RCAUTOT,RCDIVTXT,RCPYRTXT,RCSTR,RCTYPTXT,RCCLMTXT
- +5 ;
- +6 SET RCDIVTXT=$$DIVTXT^RCDPENR1()
- +7 SET RCPYRTXT=$SELECT(RCPAY="S":"SELECTED",RCPAY="R":"RANGE",1:"ALL")_" "
- +8 SET RCPYRTXT=RCPYRTXT_$SELECT(RCWHICH=2:"TINS",1:"PAYERS")
- +9 SET RCTYPTXT=$SELECT('+$GET(RCEXCEL):"MEDICAL/PHARMACY/TRICARE/CHAMPVA: ",1:"")
- +10 ;PRCA*4.5*432 Add CHAMPVA
- SET RCTYPTXT=RCTYPTXT_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")
- +11 SET RCAUTOT="MANUAL/AUTOPOST: "_$SELECT(RCAUTO="N":"MANUAL",RCAUTO="A":"AUTOPOST",1:"BOTH")
- +12 ; PRCA*4.5*349
- SET RCCLMTXT="Claims: "_$SELECT(RCCLM="C":"CLOSED",1:"ALL")
- +13 ;
- +14 SET RCPAGE=RCPAGE+1
- +15 IF '+RCDISP
- Begin DoDot:1
- +16 SET RCSTR="EFT/ERA TRENDING REPORT^PAGE "_$JUSTIFY(RCPAGE,5)
- +17 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
- +18 SET RCSTR="^"_RCDIVTXT_"^"_RCPYRTXT_"^"_RCTYPTXT
- +19 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
- +20 SET RCSTR="^"_"DATE RANGE: "_$$FMTE^XLFDT(RCBGDT,2)_" - "_$$FMTE^XLFDT(RCENDDT,2)_"^"_"RUN DATE: "_RCRUNDT
- +21 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
- +22 DO SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
- End DoDot:1
- QUIT
- +23 WRITE @IOF,"EFT/ERA TRENDING REPORT"
- +24 ;
- IF '$GET(RCEXCEL)
- Begin DoDot:1
- +25 WRITE ?122,"PAGE ",$JUSTIFY(RCPAGE,5),!
- +26 ;PRCA*4.5*432 35 -> 43
- WRITE " "_$EXTRACT(RCDIVTXT,1,23),?25,$EXTRACT(RCPYRTXT,1,20),?46,$EXTRACT(RCTYPTXT,1,43)
- +27 ;PRCA*4.5*432 80 -> 90, 108 -> 118
- WRITE ?90,RCAUTOT,?118,RCCLMTXT,!
- +28 WRITE ?5,"DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
- +29 WRITE ?51,"RUN DATE: ",RCRUNDT,!
- +30 WRITE RCLINE,!
- End DoDot:1
- +31 IF +$GET(RCEXCEL)
- Begin DoDot:1
- +32 WRITE "^PAGE ",$JUSTIFY(RCPAGE,5)
- +33 WRITE "^",RCDIVTXT,"^",RCPYRTXT,"^",RCTYPTXT
- +34 WRITE "^","DATE RANGE: ",$$FMTE^XLFDT(RCBGDT,2)," - ",$$FMTE^XLFDT(RCENDDT,2)
- +35 WRITE "^","RUN DATE: ",RCRUNDT
- +36 WRITE "^",RCAUTOT,"^",RCCLMTXT,!
- End DoDot:1
- +37 ;
- +38 ; Re-display the column headers
- +39 IF '$GET(RCEXCEL)
- IF (SECTION="M")
- DO COLHEAD
- +40 IF $GET(RCEXCEL)
- IF (RCPAGE=1)
- DO COLHEAD
- +41 QUIT
- +42 ;
- +43 ;Print the Detailed portion of the report
- MAIN() ;
- +1 ;
- +2 NEW RCERATYP,RCDATA,RCERATXT,RCSTRING,RCEFTTXT,RCEFT,RCERA,RCINSTIN,RCCLAIM,RCBILL
- +3 NEW RCAMTBL,RCPAID,RCBILLDT,RCERADT,RCEFTDT,RCPOSTDT,RCTRACE,RCATPST,RCIDX,RCAMTPD
- +4 NEW RCETRAN,RCERA,RCEOB,RCEFTNO,RCBEDY,RCEEDY,RCEPDY,RCBPDY,RCMETHOD,RCTOTDY,RCTMP,RCSTOP,RCIDX
- +5 ;
- +6 ; Print ERA/EFT combinations for each Insurance Company/Tin combination
- +7 SET RCINSTIN=""
- SET RCSTOP=0
- +8 FOR
- SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN))
- if RCINSTIN=""
- QUIT
- Begin DoDot:1
- +9 SET RCMETHOD=""
- +10 FOR
- SET RCMETHOD=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD))
- if RCMETHOD=""
- QUIT
- Begin DoDot:2
- +11 ; PRCA*4.5*349
- IF (RCAUTO="A"&(RCMETHOD="MANUAL"))!(RCAUTO="N"&(RCMETHOD="AUTOPOST"))
- QUIT
- +12 ; PRCA*4.5*349 add "." to this and every subsequent line
- SET RCSTOP=$$PRINTINS(RCINSTIN)
- +13 if RCSTOP
- QUIT
- +14 FOR I=1:1:3
- Begin DoDot:3
- +15 ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
- IF RCMETHOD="AUTOPOST"
- IF I>1
- QUIT
- +16 SET RCERATYP=$SELECT(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
- +17 SET RCEFTTXT=$PIECE(RCERATYP,"/")
- +18 SET RCERATXT=$PIECE(RCERATYP,"/",2)
- +19 SET RCEFT=$SELECT(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
- +20 ; PRCA*4.5*349
- SET RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_RCMETHOD
- +21 SET RCSTOP=$$PRINTHDR(RCSTRING)
- +22 if RCSTOP
- QUIT
- +23 ; PRCA*4.5*349
- IF '$GET(RCEXCEL)
- IF $ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,I,""))=""
- Begin DoDot:4
- +24 ; PRCA*4.5*349
- WRITE "No data captured for this section during the specified time period.",!
- End DoDot:4
- +25 SET RCCLAIM=""
- +26 FOR
- SET RCCLAIM=$ORDER(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM))
- if RCCLAIM=""
- QUIT
- Begin DoDot:4
- +27 IF $Y>(IOSL-5)
- DO ASK^RCDPEADP(.RCSTOP,0)
- if RCSTOP
- QUIT
- DO HEADER
- +28 SET RCDATA=$GET(^TMP("RCDPENR2",$JOB,"MAIN",RCINSTIN,RCMETHOD,I,RCCLAIM))
- +29 IF RCDATA=""
- Begin DoDot:5
- +30 WRITE !,"No data captured for this section during the specified time period.",!
- End DoDot:5
- QUIT
- +31 ;
- +32 ;Init display values for the days
- +33 SET (RCBEDY,RCEEDY,RCEPDY,RCBPDY)=""
- +34 SET RCBILL=$$GET1^DIQ(399,+RCCLAIM_",",".01","E")
- +35 IF $PIECE(RCDATA,U,9)
- IF $PIECE(RCDATA,U,8)
- SET RCBEDY=$$FMTH^XLFDT($PIECE(RCDATA,U,9),1)-$$FMTH^XLFDT($PIECE(RCDATA,U,8),1)
- +36 IF $PIECE(RCDATA,U,10)
- IF $PIECE(RCDATA,U,9)
- SET RCEEDY=$$FMTH^XLFDT($PIECE(RCDATA,U,10),1)-$$FMTH^XLFDT($PIECE(RCDATA,U,9),1)
- +37 ; Find the latest date between ERA and EFT
- SET RCIDX=$SELECT($$FMTH^XLFDT($PIECE(RCDATA,U,10),1)>$$FMTH^XLFDT($PIECE(RCDATA,U,10),1):10,1:9)
- +38 ; Use latest date to determ days btw ERA/EFT and Posting
- IF $PIECE(RCDATA,U,11)
- IF $PIECE(RCDATA,U,RCIDX)
- SET RCEPDY=$$FMTH^XLFDT($PIECE(RCDATA,U,11),1)-$$FMTH^XLFDT($PIECE(RCDATA,U,RCIDX),1)
- +39 IF $PIECE(RCDATA,U,11)
- IF $PIECE(RCDATA,U,8)
- SET RCBPDY=$$FMTH^XLFDT($PIECE(RCDATA,U,11),1)-$$FMTH^XLFDT($PIECE(RCDATA,U,8),1)
- +40 IF RCEXCEL
- Begin DoDot:5
- +41 SET RCTMP=RCBILL_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,5),2)_"^"_$PIECE(RCDATA,U,6)_"^"_$PIECE(RCDATA,U,7)_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,8),2)
- +42 SET RCTMP=RCTMP_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,9),2)_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,10),2)_"^"_$$FMTE^XLFDT($PIECE(RCDATA,U,11),2)_"^"_$PIECE(RCDATA,U,12)_"^"_$PIECE(RCDATA,U,13)
- +43 SET RCTMP=RCTMP_"^"_$PIECE(RCDATA,U,14)_"^"_$PIECE(RCDATA,U,2)_"^"_$PIECE(RCDATA,U,15)_"^"_$PIECE(RCDATA,U,3)_"^"
- +44 SET RCTMP=RCTMP_RCBEDY_"^"_RCEEDY_"^"_RCEPDY_"^"_RCBPDY
- +45 WRITE RCTMP,!
- End DoDot:5
- +46 IF 'RCEXCEL
- Begin DoDot:5
- +47 WRITE RCBILL,?21,$$FMTE^XLFDT($PIECE(RCDATA,U,5),2),?30,$JUSTIFY($PIECE(RCDATA,U,6),10,2),?41,$JUSTIFY($PIECE(RCDATA,U,7),10,2),?52,$$FMTE^XLFDT($PIECE(RCDATA,U,8),2)
- +48 WRITE ?61,$$FMTE^XLFDT($PIECE(RCDATA,U,9),2),?75,$$FMTE^XLFDT($PIECE(RCDATA,U,10),2),?89,$$FMTE^XLFDT($PIECE(RCDATA,U,11),2),?98,$PIECE(RCDATA,U,12),?109,$PIECE(RCDATA,U,13),!
- +49 WRITE ?5,$PIECE(RCDATA,U,14),?17,$PIECE(RCDATA,U,2),?28,$JUSTIFY($PIECE(RCDATA,U,15),6),?39,$PIECE(RCDATA,U,3),?50,$JUSTIFY(RCBEDY,8)
- +50 WRITE ?67,$JUSTIFY(RCEEDY,8),?83,$JUSTIFY(RCEPDY,8),?106,$JUSTIFY(RCBPDY,8),!
- End DoDot:5
- End DoDot:4
- if RCSTOP
- QUIT
- +51 IF '$GET(RCEXCEL)
- WRITE RCLINE,!
- End DoDot:3
- if RCSTOP
- QUIT
- End DoDot:2
- if RCSTOP
- QUIT
- End DoDot:1
- if RCSTOP
- QUIT
- +52 ;
- +53 IF RCSTOP
- QUIT RCSTOP
- +54 ; Section break - ask user if they wish to continue...
- +55 ;
- +56 QUIT RCSTOP
- +57 ;
- SUMMARY() ;Print the Payer Summary portion of the report
- +1 ;
- +2 IF $GET(RCEXCEL)
- QUIT 0
- +3 ; PRCA*4.5*349
- NEW RCSTOP
- +4 ;
- +5 ; Print ERA/EFT combinations for each Insurance Company/Tin combination
- +6 SET RCINSTIN=""
- SET RCSTOP=0
- +7 FOR
- SET RCINSTIN=$ORDER(^TMP("RCDPENR2",$JOB,"PAYER",RCINSTIN))
- if RCINSTIN=""
- QUIT
- Begin DoDot:1
- +8 DO PAYSUM^RCDPENR4(RCINSTIN)
- End DoDot:1
- if RCSTOP
- QUIT
- +9 QUIT RCSTOP
- +10 ;
- +11 ;Total for all payers in report
- GRAND() ;
- +1 IF $GET(RCEXCEL)
- QUIT 0
- +2 ;
- +3 ; PRCA*4.5*349
- NEW I,J,RCDATA,RCEFT,RCERA,RCERAFLG,RCEFTTXT,RCERATXT,RCERATYP,RCSTRING,RCSTOP
- +4 ;
- +5 SET RCSTOP=0
- +6 ; Print the Grand Total Banner
- +7 IF $Y>(IOSL-7)
- IF RCDISP
- DO ASK^RCDPEADP(.RCSTOP,0)
- if RCSTOP
- QUIT
- DO HEADER
- +8 IF RCSUMFLG'="G"
- IF RCDISP
- Begin DoDot:1
- +9 WRITE !,"GRAND TOTALS ALL PAYERS",!!
- +10 WRITE RCLINE,!
- End DoDot:1
- +11 ;
- +12 ; Print all 3 EOB/Payment combinations
- +13 ; PRCA*4.5*349
- FOR J="AUTOPOST","MANUAL","TOTAL"
- if RCSTOP
- QUIT
- FOR I=1:1:3
- Begin DoDot:1
- +14 ; Only EFT/ERA can be auto-posted - PRCA*4.5*349
- IF J="AUTOPOST"
- IF I>1
- QUIT
- +15 ; PRCA*4.5*349
- IF (RCAUTO="A"&(J="MANUAL"))!(RCAUTO="N"&(J="AUTOPOST"))!(RCAUTO'="B"&(J="TOTAL"))
- QUIT
- +16 ; PRCA*4.5*349
- SET RCDATA=$GET(^TMP("RCDPENR2",$JOB,"GTOT",J,I))
- +17 SET RCERATYP=$SELECT(I=1:"EFT/ERA",I=2:"PAPER CHECK/ERA",1:"EFT/PAPER EOB")
- +18 SET RCERAFLG=0
- +19 SET RCEFTTXT=$PIECE(RCERATYP,"/")
- +20 SET RCERATXT=$PIECE(RCERATYP,"/",2)
- +21 SET RCEFT=$SELECT(RCEFTTXT="EFT":"AN EFT",1:"A PAPER CHECK")
- +22 ; PRCA*4.5*349
- SET RCSTRING=RCERATXT_" MATCHED TO "_RCEFT_" - "_J
- +23 IF (RCEFTTXT="EFT")
- IF (RCERATXT["ERA")
- SET RCERAFLG=1
- +24 DO PRINTGT^RCDPENR3(RCSTRING,RCDATA,RCDISP,RCERAFLG,RCEXCEL)
- End DoDot:1
- if RCSTOP
- QUIT
- +25 ;
- +26 QUIT RCSTOP
- +27 ;
- PRINTINS(RCINS) ; Print the insurance header line
- +1 ; Input: RCINS - Payer Name/TIN to be displayed
- +2 ; RCLINE - line of dashes used for separation
- +3 ; Returns 1 - User quit out of report, 0 otherwise
- +4 IF $GET(RCEXCEL)
- QUIT 0
- +5 NEW RCSTOP,XX,YY,ZZ
- +6 ;
- +7 SET RCSTOP=0
- +8 IF $Y>(IOSL-7)
- Begin DoDot:1
- +9 DO ASK^RCDPEADP(.RCSTOP,0)
- +10 if RCSTOP
- QUIT
- +11 DO HEADER
- End DoDot:1
- +12 IF RCSTOP
- QUIT RCSTOP
- +13 WRITE "PAYER NAME/TIN",!
- +14 WRITE " ",$$PAYTIN^RCDPRU2(RCINS,78),!
- +15 WRITE RCLINE,!
- +16 QUIT RCSTOP
- +17 ;
- +18 ;Print the Payment Method header lines
- PRINTHDR(RCTITLE) ;
- +1 ; Undeclared parameters
- +2 ; RCLINE - line of "-" for report formating
- +3 ; RCSUMFLG - Type of report (M=Main,S=Summary,G=Grand Total)
- +4 ; RCDISP - Is the report being email (0) or Printed (1)
- +5 ; RCRPIEN - IEN to store the report if emailing
- +6 ;
- +7 IF $GET(RCEXCEL)
- QUIT 0
- +8 NEW RCBORDER,RCSTOP,RCSTR
- +9 ;
- +10 SET RCBORDER=""
- SET $PIECE(RCBORDER,"*",20)=""
- SET RCSTOP=0
- +11 IF $Y>(IOSL-7)
- IF RCDISP
- Begin DoDot:1
- +12 DO ASK^RCDPEADP(.RCSTOP,0)
- +13 if RCSTOP
- QUIT
- +14 DO HEADER
- End DoDot:1
- +15 IF RCSTOP
- QUIT RCSTOP
- +16 ;
- +17 ; Display report type being displayed
- +18 IF 'RCDISP
- Begin DoDot:1
- +19 SET RCSTR=RCBORDER_" "_RCTITLE_" "_RCBORDER
- +20 DO SAVEDATA^RCDPENR1(RCSTR,RCRPIEN)
- +21 DO SAVEDATA^RCDPENR1(RCLINE,RCRPIEN)
- End DoDot:1
- QUIT
- +22 IF RCDISP
- Begin DoDot:1
- +23 WRITE RCBORDER," ",RCTITLE," ",RCBORDER,!
- +24 WRITE RCLINE,!
- End DoDot:1
- +25 ;
- +26 QUIT RCSTOP
- +27 ;
- GETDIV(RCDIV) ; Retrieve the Division
- +1 ; PRCA*4.5*349 - Moved to RCDPENR4 for size
- +2 QUIT $$GETDIV^RCDPENR4(.RCDIV)
- +3 ;
- +4 ;Retrieve the Report Type
- GETRATE() ;
- +1 ;
- +2 ;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
- +3 NEW X,Y,DIC,DTOUT,DUOUT
- +4 ;
- +5 SET DIC="^DGCR(399.3,"
- SET DIC(0)="AEQMN"
- +6 SET DIC("S")="I $P(^(0),U,7)=""i"""
- +7 DO ^DIC
- KILL DIC
- +8 QUIT +Y
- +9 ;
- +10 ;Retrieve the Report Type
- GETRPT(RCMNFLG) ;
- +1 ;
- +2 ;RCMNFLG - Ask to print the Main report (Detailed) report. 0=No, 1=Yes
- +3 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT
- +4 ;
- +5 ; Prompt with Main (EFT/ERA Trending report (from RCDPENR2))
- +6 IF $GET(RCMNFLG)
- Begin DoDot:1
- +7 SET DIR("A")="Print (M)AIN Report, (S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
- +8 SET DIR(0)="SA^M:MAIN;S:SUMMARY;G:GRAND TOTAL"
- End DoDot:1
- +9 ;
- +10 ; Prompt w/o main (Volume Statistics report (from RCDPENR1))
- +11 IF '$GET(RCMNFLG)
- Begin DoDot:1
- +12 SET DIR("A")="(S)UMMARY by Payer or (G)RAND TOTALS ONLY: "
- +13 SET DIR(0)="SA^S:SUMMARY;G:GRAND TOTAL"
- End DoDot:1
- +14 ;
- +15 SET DIR("?")="Select the type of report to Generate."
- +16 SET DIR("B")="G"
- +17 DO ^DIR
- KILL DIR
- +18 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
- QUIT -1
- +19 QUIT Y
- +20 ;
- +21 ;
- GETSDATE() ;
- +1 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCTODAY
- +2 ;
- +3 ;Assume the start date is 45 days prior to the end date
- +4 ;
- +5 ;Get the start date.
- +6 SET RCTODAY=$PIECE($$NOW^XLFDT,".")
- +7 SET DIR("?")="ENTER THE EARLIEST DATE TO INCLUDE ON THE REPORT"
- +8 SET DIR(0)="DA^:"_RCTODAY_":APE"
- SET DIR("A")="Start with DATE: "
- +9 DO ^DIR
- KILL DIR
- +10 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
- QUIT -1
- +11 QUIT Y
- +12 ;
- +13 ; Retrieve the end date of the report from the user.
- GETEDATE(RCBDATE) ;
- +1 ; RCBDATE - Begin date of the report. Used as a lower bound
- +2 ;
- +3 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCTODAY
- +4 ;
- +5 ; Get the End date first. Assume the end date is today.
- +6 SET RCTODAY=$PIECE($$NOW^XLFDT,".")
- +7 SET DIR("?")="ENTER THE LATEST DATE TO INCLUDE ON THE REPORT"
- +8 SET DIR("B")=$$FMTE^XLFDT(RCTODAY,2)
- +9 SET DIR(0)="DAO^"_$GET(RCBDATE)_":"_RCTODAY_":APE"
- SET DIR("A")="Go to DATE: "
- DO ^DIR
- KILL DIR
- +10 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
- QUIT -1
- +11 QUIT Y
- +12 ;
- GETARPYR(RCTIN,RCPAY) ; Retrieve the Payer IEN from the RCDPE AUTO-PAY EXCLUSION file (#344.6)
- +1 ; Input: RCTIN - Payer ID
- +2 ; RCPAY - Payer Name (optional)
- +3 ; Return: Payer IEN (#344.6)
- +4 ;
- +5 NEW RCIEN,QUIT,ZZ
- +6 SET RCPAY=$GET(RCPAY)
- +7 ;
- +8 ; Send the IEN entry in the file if the Payer is in it. Otherwise, send 0.
- +9 SET RCIEN=0
- +10 ;
- +11 ; PRCA*4.5*321 - Add optional payer name to search to narrow down payer
- +12 ;
- IF RCPAY'=""
- Begin DoDot:1
- +13 SET ZZ=""
- SET QUIT=0
- +14 ;
- FOR
- SET ZZ=$ORDER(^RCY(344.6,"C",RCTIN_" ",ZZ))
- if ZZ=""
- QUIT
- Begin DoDot:2
- +15 IF $$GET1^DIQ(344.6,ZZ_",",.01,"E")=RCPAY
- SET RCIEN=ZZ
- End DoDot:2
- IF RCIEN
- QUIT
- End DoDot:1
- +16 ;
- +17 ;
- IF 'RCIEN
- Begin DoDot:1
- +18 SET RCIEN=$ORDER(^RCY(344.6,"C",RCTIN_" ",""))
- End DoDot:1
- +19 ;
- +20 QUIT +RCIEN
- +21 ;
- +22 ; Determine if the payer in the ERA or EFT should be included in the report.
- INSCHK(RCINS) ;
- +1 ;
- +2 ;Send yes if all payers are being reported on.
- +3 if $DATA(^TMP("RCDPENR2",$JOB,"INS","A"))
- QUIT 1
- +4 ;
- +5 ; Send yes if Payer is in the list to report on
- +6 if $DATA(^TMP("RCDPENR2",$JOB,"INS",RCINS))
- QUIT 1
- +7 ;
- +8 ; Otherwise, send no
- +9 QUIT 0
- +10 ;
- DIV(RCDIV) ; build the list of divisions to report on.
- +1 ; PRCA*4.5*349 - Moved to RCDPENR4 for size
- +2 DO DIV^RCDPENR4(.RCDIV)
- +3 QUIT
- +4 ;Determine the text to display for the Payer TINs
- TINTXT() ;
- +1 ;
- +2 NEW RCTIN,RCTXT,RCTNTXT
- +3 ;
- +4 if $DATA(^TMP("RCDPEADP",$JOB,"TIN","A"))
- QUIT "ALL PAYER TINS"
- +5 ;
- +6 ;Build list of Payer Tins
- +7 ;
- +8 SET RCTIN=""
- SET RCTXT=""
- +9 FOR
- SET RCTIN=$ORDER(^TMP("RCDPEADP",$JOB,"TIN",RCTIN))
- if RCTIN=""
- QUIT
- Begin DoDot:1
- +10 SET RCTNTXT=$$GET1^DIQ(344.6,+RCTIN_",",".02","I")
- +11 SET RCTXT=RCTXT_RCTNTXT_","
- End DoDot:1
- +12 ;
- +13 ; Remove comma at the end.
- +14 SET RCTXT=$EXTRACT(RCTXT,1,$LENGTH(RCTXT)-1)
- +15 ;
- +16 ; Display the first 35 characters of the division text list,
- +17 QUIT $EXTRACT(RCTXT,1,35)
- +18 ;
- COLHEAD ;
- +1 ;
- +2 NEW RCTMP
- +3 ;
- +4 ;Display the column headers
- +5 IF RCEXCEL
- Begin DoDot:1
- +6 SET RCTMP="CLAIM#^DOS^AMT BILLED^AMT PAID^BILLED^ERA/EOB REC'D^EFT/PMT REC'D^POSTED^TRACE #^AUTOPOST/MANUAL"
- +7 SET RCTMP=RCTMP_"^ETRANS TYPE^ERA#^#EEOBS^EFT#^#DAYS:(BILL/ERA)^#DAYS:(ERA/EFT)^#DAYS:(ERA+EFT/POSTED)^"
- +8 SET RCTMP=RCTMP_"TOTAL #DAYS(BILL/POSTED)"
- +9 WRITE RCTMP,!
- End DoDot:1
- +10 IF 'RCEXCEL
- Begin DoDot:1
- +11 WRITE "CLAIM#",?21,"DOS",?30,"AMT BILLED",?41,"AMT PAID",?52,"BILLED",?61,"ERA/EOB REC'D",?75,"EFT/PMT REC'D",?89,"POSTED",?98,"TRACE #",?109,"AUTOPOST/MANUAL",!
- +12 WRITE ?5,"ETRANS TYPE",?17,"ERA#",?28,"#EEOBS",?39,"EFT#",?50,"#DAYS:(BILL/ERA)",?67,"#DAYS:(ERA/EFT)",?83,"#DAYS:(ERA+EFT/POSTED)",?106,"TOTAL #DAYS(BILL/POSTED)",!
- +13 WRITE RCLINE,!
- End DoDot:1
- +14 QUIT
- +15 ;
- +16 ;Entry point for reprinting the header.
- REPRINT(RCIEN) ;
- +1 ;
- +2 NEW I,RCDATA,J,RCSTOP,PAGE
- +3 ;
- +4 ;
- +5 SET PAGE=1
- +6 DO RPTHDR(RCIEN,PAGE)
- +7 ;
- +8 ;loop through the main body
- SET I=4
- SET RCSTOP=0
- +9 FOR
- SET I=$ORDER(^RCDM(344.91,RCIEN,1,I))
- if 'I
- QUIT
- Begin DoDot:1
- +10 SET RCDATA=$GET(^RCDM(344.91,RCIEN,1,I,0))
- +11 ;
- +12 IF $Y>(IOSL-4)
- Begin DoDot:2
- +13 DO ASK^RCDPEADP(.RCSTOP,0)
- +14 if RCSTOP
- QUIT
- +15 SET PAGE=PAGE+1
- +16 DO RPTHDR(RCIEN,PAGE)
- End DoDot:2
- if RCSTOP
- QUIT
- +17 ; main body of report
- +18 WRITE $PIECE(RCDATA,U)
- +19 IF RCDATA["^"
- WRITE ?65,$PIECE(RCDATA,U,2)
- +20 ;Add <CRLF>
- WRITE !
- End DoDot:1
- if RCSTOP
- QUIT
- +21 QUIT
- +22 ;
- RPTHDR(RCIEN,PAGE) ; Reprint the header
- +1 ;
- +2 NEW I,RCDATA
- +3 ;
- +4 ; Create new page
- WRITE @IOF
- +5 ;
- +6 FOR I=1:1:4
- Begin DoDot:1
- +7 SET RCDATA=$GET(^RCDM(344.91,RCIEN,1,I,0))
- +8 ; header lines formatting
- +9 IF I=1
- WRITE ?15,$PIECE(RCDATA,U),?70,PAGE,!
- QUIT
- +10 IF I=2
- WRITE ?5,$PIECE(RCDATA,U,2),!
- QUIT
- +11 IF I=3!(I=4)
- WRITE ?5,$PIECE(RCDATA,U,2),?45,$PIECE(RCDATA,U,3),!
- QUIT
- End DoDot:1
- +12 QUIT