RCDPEAPP ;OIFO-BAYPINES/PJH - AUTO POST REPORT ;Dec 20, 2014@18:42
;;4.5;Accounts Receivable;**298,304,326,345**;Mar 20, 1995;Build 34
;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 DIVISION^VAUTOMA via Controlled IA 664
; PRCA*4.5*326 - Extensive re-write of this routine to add selection/sort by Payer TIN
RPT ; entry point for Auto-Post Report [RCDPE AUTO-POST REPORT]
N POP,RCDISP,RCDIV,RCDIVS,RCDTRNG,RCJOB,RCLAIM,RCPAGE,RCPAR,RCPARRAY,RCPAY,RCPROG,RCRANGE
N RCSORT,RCTYPE,RCWHICH,STANAM,STANUM,X,Y
S (RCDTRNG,RCPAGE)=0,RCPROG="RCDPEAPP",RCJOB=$J ; Initialize page and start point
S RCDIV=$$STADIV(.RCDIVS) Q:'RCDIV ; Select Filter/Sort by Division
S RCTYPE=$$DETORSUM() Q:RCTYPE=-1 ; Detail or Summary mode
;
S RCLAIM=$$RTYPE^RCDPEU1() Q:RCLAIM=-1 ; PRCA*4.5*326 - Add Tricare filter to Med/Pharm/Both
S RCWHICH=$$NMORTIN() Q:RCWHICH=-1 ; PRCA*4.5*326 - Filter by Payer Name or TIN
;
S RCPAR("SELC")=$$PAYRNG^RCDPEU1(0,1,RCWHICH) ; PRCA*4.5*326 - Selected or Range of Payers
Q:RCPAR("SELC")=-1 ; PRCA*4.5*326 '^' or timeout
S RCPAY=RCPAR("SELC")
;
I RCPAR("SELC")'="A" D Q:XX=-1 ; PRCA*4.5*326 - Since we don't want all payers
. S RCPAR("TYPE")=RCLAIM
. S RCPAR("SRCH")=$S(RCWHICH=2:"T",1:"N") ; prompt for payers we do want
. S RCPAR("FILE")=344.4
. S RCPAR("DICA")="Select Insurance Company"_$S(RCWHICH=1:" NAME: ",1:" TIN: ")
. S XX=$$SELPAY^RCDPEU1(.RCPAR)
;
S RCSORT=$$SORTT() Q:RCSORT=-1 ; Select Sort
S RCRANGE=$$DTRNG() Q:RCRANGE=0 ; Select Date Range for Report
I RCTYPE="S" S RCDISP=0 ; Excel not implemented for summary report - PRCA*4.5*345
E S RCDISP=$$DISPTY() Q:RCDISP=-1 ; Output to Excel?
I RCDISP D INFO^RCDPEM6 ; Display capture information for Excel
;
I 'RCDISP W !,"This report requires 132 column display."
S %ZIS="QM" D ^%ZIS Q:POP ; Select output device
;
; Option to queue
I 'RCDISP,$D(IO("Q")) D Q
. N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
. S ZTRTN="REPORT^RCDPEAPP"
. S ZTDESC="EDI LOCKBOX AUTO POST REPORT"
. S ZTSAVE("RC*")="" ;**FA** ,ZTSAVE("VAUTD")=""
. S ZTSAVE("^TMP(""RCDPEU1"",$J,")="" ; PRCA*4.5*326
. D ^%ZTLOAD
. I $D(ZTSK) W !!,"Task number "_ZTSK_" was queued."
. E W !!,"Unable to queue this job."
. K IO("Q")
. D HOME^%ZIS
;
D REPORT ; Compile and print report
Q
;
STADIV(DIVS) ; Division/Station Filter/Sort
; Input: None
; Output: DIVS(A1)=A1^A3 Selected Divisions (if not 'ALL') Where:
; A1 - Division IEN
; A2 - Division Name
; A3 - Station Number
; Returns: -1 - User ^ or timed out
; 1 - All divisions selected
; 2 - Selected Divisions
N DIR,DIRUT,DIROUT,DIV,DTOUT,DUOUT,STNUM,VAUTD,Y
D DIVISION^VAUTOMA Q:Y<0 -1 ; IA 664
I VAUTD=1 S RCDIV=1 Q 1 ; All Divisions selected
K DIVS
S DIV=""
F D Q:DIV=""
. S DIV=$O(VAUTD(DIV))
. Q:DIV=""
. S STNUM=$$GET1^DIQ(40.8,DIV,1,"E")
. S:STNUM="" STNUM="UNKNOWN"
. S DIVS(DIV)=VAUTD(DIV)_"^"_STNUM
Q 2 ; Some Divisions selected
;
DETORSUM() ; Ask the user wants to see the detail or summary report
; Input: None
; Returns: -1 - User ^ or timed out
; D - Detail Mode
; S - Summary Mode
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
S DIR(0)="SA^S:SUMMARY;D:DETAIL;",DIR("A")="Display (S)UMMARY or (D)ETAIL Format?: "
S DIR("B")="DETAIL"
S XX="Select 'SUMMARY' to see the summary report or "
S DIR("?")=XX_"'DETAIL' to see the detail report"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q Y
;
NMORTIN() ; EP - Ask the user if they want to filter by Payer Name or TIN
; Input: None
; Returns: -1 - User ^ or timed out
; 1 - Filter by Payer Name
; 2 - Filter by Payer TIN
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="SA^N:NAME;T:TIN;"
S DIR("A")="Select Insurance Companies by NAME or TIN: "
S DIR("B")="TIN"
S DIR("?")="Select 'NAME' to select Payers by name or 'TIN' to select Payers by TIN"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q:Y="N" 1
Q 2
;
SELPAY(RCJOB,RCPARRAY) ; Move ^TMP("RCSELPAY",RCJOB) into RCPARRAY for lookup
; note that payer names for 344.4 are UPPER CASE
; Input: RCJOB - $J
; ^TMP("RCSELPAY",RCJOB,) - Temp array of selected Payers
; Output: RCPARRAY(A1,A2)=A3 - Array of selected Payers Where:
; A1 - Payer Name or TIN based on the way ^TMP("RCSELPAY" was built
; A2 - Counter
; A3 - Payer Name/TIN or TIN/Payer Name based on the way ^TMP("RCSELPAY" was built
N PAYER,PSUB
S PSUB=0
F S PSUB=$O(^TMP("RCSELPAY",RCJOB,PSUB)) Q:'PSUB D
. S PAYER=$G(^TMP("RCSELPAY",RCJOB,PSUB))
. S:PAYER'="" RCPARRAY($P(PAYER,"/",1),PSUB)=PAYER
Q
;
SORTT() ; Ask the user if they want to sort by Payer Name or Payer TIN
; Input: None
; Returns: -1 - User ^ or timed out
; 0 - Sort by Payer Name
; 1 - Sort by Payer TIN
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="SA^N:NAME;T:TIN;"
S DIR("A")="Sort by Insurance Company NAME or TIN: "
S DIR("B")="TIN"
S DIR("?",1)="Select 'NAME' to sort by Division/Payer Name or"
S DIR("?")="select 'TIN' to sort by Division/Payer TIN"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q:Y="N" 0
Q 1
;
DTRNG() ; Get the date range for the report
; Input: None
; Returns: 0 - User ^ or timed out
; 1^Start Date^End Date
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCEND,RNGFLG,RCSTART,X,Y
D DATES(.RCSTART,.RCEND)
Q:RCSTART=-1 0
Q:RCSTART "1^"_RCSTART_"^"_RCEND
Q:'RCSTART "0^^"
Q 0
;
DISPTY() ; Get display/output type
; Input: None
; Return:: -1 - User ^ or timed out
; 0 - Not to Excel
; 1 - Output to Excel
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="Y"
S DIR("A")="Export the report to Microsoft Excel"
S DIR("B")="NO"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) -1
Q Y
;
DATES(BDATE,EDATE) ; Get a date range.
; Input: None
; Output: BDATE - Internal Begin date
; EDATE - Internal End date
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S (BDATE,EDATE)=0
S DIR("?")="Enter the earliest Auto-Posting date to include on the report"
S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Start Date: "
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q
S BDATE=Y
S DIR("?")="Enter the latest Auto-Posting date to include on the report"
S DIR("B")=Y(0)
S DIR(0)="DAO^"_BDATE_":"_DT_":APE",DIR("A")="End Date: "
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q
S EDATE=Y
Q
;
REPORT ; Compile and print report
; Input: RCDISP - 0 - Output to paper or screen, 1 - Output to Excel
; RCDIV - 1 - All divisions, 2 - Selected divisions
; RCDIVS()- Array of selected divisions if RCDIV=2
; RCRANGE - 1^Start Date^End Date
; RCJOB - $J
; RCLAIM - "M" - Medical Claims, "P" - Pharmacy Claims, "B" - Both
; RCPAGE - Initialized to 0
; RCPARRAY- Array of selected payers
; RCPROG - "RCDPEAPP"
; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
; RCTYPE - 'D' for detail report, 'S' for summary
; RCWHICH - 1 - Filter by Payer Name, 2 - Filter by Payer TIN
; ^TMP("RCDPEU1",$J) - Selected payerers (see SELPAY^RCDPEU1 for details)
;
N GLOB,GTOTAL,ZTREQ
K ^TMP(RCPROG,$J),^TMP("RCDPEAPP2",$J)
S GLOB=$NA(^TMP(RCPROG,$J))
D COMPILE^RCDPEAPQ ; Scan ERA file for entries in date range
D DISP ; Display the Report
;
; Clear ^TMP global
K ^TMP(RCPROG,$J),^TMP("RCSELPAY",RCJOB),^TMP("RCDPEAPP2",$J),^TMP("RCDPEU1",$J) ; PRCA*4.5*326
Q
;
DISP ; Format the display for screen/printer or MS Excel
; Input: GLOB - "^TMP("RCDPEAPP",$J)
; RCDISP - 1 - Output to Excel, 0 otherwise
; RCDIV - 1 - All Divisions selected
; RCDIVS - Array of selected Divisions (if all not selected)
; RCPARRAY- Array of selected Payers
; RCPAY - 1 - All Payers selected
N DIVS,LINE1,LINE2,PAYERS,RCDATA,RCHDRDT,RCSTOP,SUB,SUB1,SUB2,SUB3
S RCHDRDT=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ") ; Date/time for header
S LINE1=$TR($J("",131)," ","-"),LINE2=$TR(LINE1,"-","=")
U IO
;
; Report by division or 'ALL'
D LINED(RCDIV,.RCDIVS,.DIVS) ; Format Division filter
D LINEP(RCPAY,.RCPARRAY,RCWHICH,.PAYERS) ; Format Payer filter
S SUB="",RCSTOP=0
I RCDISP D HDR(.DIVS,.PAYERS) ; Single header for Excel
I RCTYPE="D" F S SUB=$O(@GLOB@(SUB)) Q:SUB="" D Q:RCSTOP ; PRCA*4.5*345 Loop for Detail report
. I 'RCDISP D
. . D HDR(.DIVS,.PAYERS) ; Display Header
. . W !,"DIVISION: ",SUB
. S SUB1="" ; Division
. F S SUB1=$O(@GLOB@(SUB,SUB1)) Q:SUB1="" D Q:RCSTOP
. . S SUB2=""
. . F S SUB2=$O(@GLOB@(SUB,SUB1,SUB2)) Q:SUB2="" D Q:RCSTOP
. . . ;
. . . ; Display payer sub-header for detail report only
. . . I 'RCDISP,RCTYPE="D" D HDRP(SUB1_"/"_SUB2)
. . . S SUB3=""
. . . F S SUB3=$O(@GLOB@(SUB,SUB1,SUB2,SUB3)) Q:SUB3="" D Q:RCSTOP
. . . . S RCDATA=@GLOB@(SUB,SUB1,SUB2,SUB3)
. . . . I 'RCDISP D Q:RCSTOP
. . . . . I $Y>(IOSL-6) D HDR(.DIVS,.PAYERS) Q:RCSTOP
. . . . . W !,$P(RCDATA,U,4) ; Patient Name
. . . . . W ?31,$P(RCDATA,U,5) ; ERA#
. . . . . W ?38,$P(RCDATA,U,6) ; Date Received
. . . . . W ?49,$P(RCDATA,U,7) ; Date Autposted
. . . . . W ?58,$P(RCDATA,U,8) ; EFT#
. . . . . W ?67,$P(RCDATA,U,9) ; "TR" Receipt
. . . . . W ?79,$E($P(RCDATA,U,10),1,12) ; Bill #
. . . . . ; PRCA*4.5*345 - Begin modified code block
. . . . . W ?90,$J($P(RCDATA,U,11),10,2) ; Original Billed Amount
. . . . . W $J($P(RCDATA,U,12),10,2) ; Paid Amount
. . . . . W $J($P(RCDATA,U,13),10,2) ; Balance
. . . . . W $J($P(RCDATA,U,14),10,2) ; % COLLECTED
. . . . . W !,?8,"DEP#:",$P(RCDATA,U,16) ; Deposit #
. . . . . W ?25,"TRACE#:",$P(RCDATA,U,15) ; Trace #
. . . . . ; PRCA*4.5*345 - End modified code block
. . . . . ;
. . . . . ; Subtotals for Payer on detail report
. . . . . I 'RCDISP,$O(@GLOB@(SUB,SUB1,SUB2,SUB3))="" D TOTALDP(SUB,SUB1,SUB2)
. . . . I RCDISP D
. . . . . I $L(RCDATA)>255 D ;
. . . . . . N RCPAY,RCTIN
. . . . . . S RCPAY=$P(RCDATA,"^",3)
. . . . . . S RCTIN=$P(RCPAY,"/",$S(RCSORT=0:2,1:1))
. . . . . . S RCPAY=$P(RCPAY,"/",$S(RCSORT=0:1,1:2))
. . . . . . S RCPAY=$E(RCPAY,1,$L(RCPAY)-($L(RCDATA)-255))
. . . . . . S RCPAY=$S(RCSORT=0:RCPAY_"/"_RCTIN,1:RCTIN_"/"_RCPAY)
. . . . . . S $P(RCDATA,"^",3)=RCPAY
. . . . . W !,RCDATA
. . . ;
. . . ; Subtotals for Division on detail report
. . . I 'RCDISP,RCTYPE="D",$O(@GLOB@(SUB,SUB1))="" D TOTALD(SUB)
;
; Grand totals
I $D(GTOTAL),'RCSTOP D
. I 'RCDISP,RCTYPE="D" D TOTALG ; Print grand only total if detail report
. I 'RCDISP,RCTYPE="S" D TOTALS ; Print all totals if summary report
. W !,$$ENDORPRT^RCDPEARL D:'$G(ZTSK) ASK(.RCSTOP)
;
I '$D(GTOTAL) D ; Null Report
. D HDR(.DIVS,.PAYERS)
. W !!,?26,"*** NO RECORDS TO PRINT ***",!
. W !,$$ENDORPRT^RCDPEARL D:'$G(ZTSK) ASK(.RCSTOP) ; PRCA*4.5*326
;
; Close device
I '$D(ZTQUEUED) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
ASK(STOP) ; Ask to continue
; Output: STOP - 1 if display is aborted
I $E(IOST,1,2)'["C-" Q ; Not displaying to screen, quit
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR("A")="Press ENTER to continue: "
S DIR(0)="EA"
D ^DIR
I ($D(DIRUT))!($D(DUOUT)) S STOP=1
Q
;
HDR(DIVS,PAYERS) ; Print the report header
; Input: DIVS() - Array of selected Division lines for Header
; PAYERS() - Array of selected Payer lines for Header
; RCDISP - 1 - Output to Excel, 0 otherwise
; RCHDRDT - External Print Date/Tim
; RCPAGE - Current Page number
; RCRANGE - Selected Date Range
; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
; RCSTOP - 1 if display aborted
; Output: RCPAGE - Updated Page Number
; RCSTOP - 1 if display aborted
N END,LN,MSG,START,XX,Y
Q:RCSTOP
I RCDISP D Q ; Output to Excel
. S XX="STATION^STATION NUMBER^PAYER^PATIENT NAME/SSN^ERA#^DT REC'D"
. S XX=XX_"^DT POST^EFT#^RECEIPT#^BILL#^AMT BILLED^AMT PAID^BALANCE^%COLL^TRACE#^DEPOSIT#"
. W !,XX
S START=$$FMTE^XLFDT($P(RCRANGE,U,2),"2DZ")
S END=$$FMTE^XLFDT($P(RCRANGE,U,3),"2DZ")
I RCPAGE D ASK(.RCSTOP) Q:RCSTOP
S RCPAGE=RCPAGE+1
W @IOF
S MSG(1)="EDI LOCKBOX AUTO-POST REPORT - "_$S(RCTYPE="D":"DETAIL ",1:"SUMMARY")
S MSG(1)=MSG(1)_$J("",47)_"Print Date: "_RCHDRDT_" Page: "_RCPAGE
;
S LN=2,XX=""
F D Q:XX="" ; Display Division filters
. S XX=$O(DIVS(XX))
. Q:XX=""
. S MSG(LN)=DIVS(XX),LN=LN+1
;
S MSG(LN)="CLAIM TYPE: "
S MSG(LN)=MSG(LN)_$S(RCLAIM="P":"PHARMACY",RCLAIM="M":"MEDICAL",RCLAIM="T":"TRICARE",1:"ALL")
S MSG(LN)=MSG(LN)_$J("",55-$L(MSG(LN)))_"SORTED BY: "_$S(RCSORT=0:"PAYER NAME",1:"PAYER TIN") ; PRCA*4.5*326
S LN=LN+1
S MSG(LN)=$S(RCWHICH=2:"TINS",1:"PAYERS")_" : "_$S(RCPAY="S":"SELECTED",RCPAY="R":"RANGE",1:"ALL") ; PRCA*4.5*326
S LN=LN+1
S MSG(LN)="AUTOPOST POSTING RESULTS FOR DATE RANGE: "_START_" - "_END
S LN=LN+1,MSG(LN)=LINE2
S LN=LN+1
I RCTYPE="D" D ;
. S MSG(LN)="PATIENT NAME/SSN ERA# DT REC'D DT POST EFT# RECEIPT# BILL#"
E S MSG(LN)=" "
S MSG(LN)=MSG(LN)_" AMT BILLED AMT PAID BALANCE %COLL"
S LN=LN+1,MSG(LN)=LINE2
D EN^DDIOL(.MSG)
Q
;
HDRP(PAYNAM) ; Print Payer Sub-header
; Input: LINE1 - 131 '-'s
; PAYNAM - TIN/Payer Name or Payer NAME/TIN depending on sort
W !,LINE1,!,"PAYER: ",PAYNAM,!,LINE1
Q
;
LINED(RCDIV,RCDIVS,DIVS) ; List selected Divisions
; Input: RCDIV - 1 - All Divisions Selected,
; RCDIVS()- Array of selected Divisions
; Output DIVS() - Array of lines to print the Divisions
; Returns: Comma Delimitted list of Divisions
N LN,SUB,XX
K DIVS
S SUB="",LN=1,DIVS(1)="DIVISIONS: "
I RCDIV=1 S DIVS(1)=DIVS(1)_"ALL" Q
F D Q:'SUB
. S SUB=$O(RCDIVS(SUB))
. Q:'SUB
. S XX=$P(RCDIVS(SUB),"^",2)
. I $L(XX)+$L(DIVS(LN))+2>132 D
. . S LN=LN+1,DIVS(LN)=" "_XX
. E S DIVS(LN)=$S($L(DIVS(LN))=12:DIVS(LN)_XX,1:DIVS(LN)_", "_XX)
Q
;
LINEP(RCPAY,RCPARRAY,RCWHICH,PAYERS) ; List selected Payers
; Input: RCPAY - 2 - All Payers selected
; RCPARRAY - Array of selected Payers
; RCWHICH - 1 - Filter by Payer Name, 2 - Filter by Payer TIN
; Output: PAYERS() - Array of lines to Print the Payers
; Returns: Comma delimited list of Payer Names
N CTR,DPAYS,LN,PAYR,PCE,XX
K PAYERS
S PAYR="",LN=1,PAYERS(1)="PAYERS: "
S PCE=$S(RCWHICH=1:2,1:1)
I $P(RCPAY,U,1)=2 S PAYERS(1)=PAYERS(1)_"ALL" Q
F D Q:PAYR=""
. S PAYR=$O(RCPARRAY(PAYR))
. Q:PAYR=""
. S CTR=""
. F D Q:CTR=""
. . S CTR=$O(RCPARRAY(PAYR,CTR))
. . Q:CTR=""
. . S XX=$P(RCPARRAY(PAYR,CTR),"/",PCE) ; Payer TIN
. . Q:$D(DPAYS(XX)) ; Already displayed
. . S DPAYS(XX)=""
. . I $L(XX)+$L(PAYERS(LN))+2>132 D
. . . S LN=LN+1,PAYERS(LN)=" "_XX
. . E S PAYERS(LN)=$S($L(PAYERS(LN))=12:PAYERS(LN)_XX,1:PAYERS(LN)_", "_XX)
Q
;
TOTALS ; Print totals for summary report
; Input: GLOB - "^TMP("RCPDEAPP",$J)
N DBAL,DBAMT,DCNT,DIV,DPAMT,PAYIX1,PAYIX2
S DIV=""
F D Q:DIV="" Q:RCSTOP
. S DIV=$O(@GLOB@(DIV))
. Q:DIV=""
. D HDR(.DIVS,.PAYERS) ; PRCA*4.5*345 Display header
. W !,"DIVISION: ",DIV,!,LINE1 ; PRCA*4.5*345 Display division
. S PAYIX1=""
. F D Q:PAYIX1="" Q:RCSTOP
. . S PAYIX1=$O(@GLOB@(DIV,PAYIX1))
. . Q:PAYIX1=""
. . S PAYIX2=""
. . F D Q:PAYIX2="" Q:RCSTOP
. . . S PAYIX2=$O(@GLOB@(DIV,PAYIX1,PAYIX2))
. . . Q:PAYIX2=""
. . . D TOTALDP(DIV,PAYIX1,PAYIX2) ; Payer Totals
. D TOTALD(DIV) ; Division Totals
D TOTALG ; Grand Totals
Q
;
TOTALD(DIV) ; Display totals for a division
; Input: DIV - Division Name
; DIVS() - Array of selected Division lines for Header
; PAYERS()- Array of selected Payer lines for Header
; GLOB - "^TMP("RCPDEAPP",$J)
; LINE1 - 131 '-'s
; RCDISP - 1 - Output to Excel, 0 otherwise
; Output: RCSTOP - 1 if display aborted, 0 otherwise
N DBAL,DBAMT,DCNT,DPAMTL
S DCNT=$P(@GLOB@(DIV),U),DBAMT=$P(@GLOB@(DIV),U,2)
S DPAMT=$P(@GLOB@(DIV),U,3),DBAL=$P(@GLOB@(DIV),U,4)
I 'RCDISP,$Y>(IOSL-6) D HDR(.DIVS,.PAYERS) Q:RCSTOP
W !,"DIVISION TOTALS FOR ",DIV,?90,$J(DBAMT,10,2)
W $J(DPAMT,10,2),$J(DBAL,10,2)
W:DBAMT'=0 $J(DPAMT/DBAMT*100,10,2),"%"
W !,?8,"COUNT",?90,$J(DCNT,10,0),$J(DCNT,10,0),$J(DCNT,10,0)
W !,?8,"MEAN",?90,$J(DBAMT/DCNT,10,2),$J(DPAMT/DCNT,10,2),$J(DBAL/DCNT,10,2)
W !,LINE1
Q
;
TOTALDP(DIV,PAYIX1,PAYIX2) ; Display totals for a payer within a division
; Input: DIV - Division Name
; PAYIX1 - Payer Name OR TIN
; PAYIX2 - TIN OR Payer Name
; DIVS() - Array of selected Division lines for Header
; GLOB - "^TMP("RCPDEAPP",$J)
; LINE1 - 131 '-'s
; PAYERS()- Array of selected Payer lines for Header
; RCDISP - 1 - Output to Excel, 0 otherwise
; Output: RCSTOP - 1 if display aborted, 0 otherwise
N DATA,DBAL,DBAMT,DCNT,DPAMT
I 'RCDISP,$Y>(IOSL-6) D HDR(.DIVS,.PAYERS) Q:RCSTOP
S DATA=@GLOB@(DIV,PAYIX1,PAYIX2) ; PRCA*4.5*345 Correct totals by payer
S DCNT=$P(DATA,U),DBAMT=$P(DATA,U,2) ; PRCA*4.5*345
S DPAMT=$P(DATA,U,3),DBAL=$P(DATA,U,4) ; PRCA*4.5*345
W:RCTYPE="D" !,?90,"-----------------------------------------"
W !,"SUBTOTALS FOR PAYER: ",PAYIX1,"/",PAYIX2,?90,$J(DBAMT,10,2),$J(DPAMT,10,2)
W $J(DBAL,10,2)
W:DBAMT'=0 $J(DPAMT/DBAMT*100,10,2),"%"
W !,?8,"COUNT",?90,$J(DCNT,10,0),$J(DCNT,10,0),$J(DCNT,10,0)
W !,?8,"MEAN",?90,$J(DBAMT/DCNT,10,2),$J(DPAMT/DCNT,10,2),$J(DBAL/DCNT,10,2)
W !,LINE1
Q
;
TOTALG ;Display overall report total
; Input: DIVS() - Array of selected Division lines for Header
; PAYERS()- Array of selected Payer lines for Header
; GTOTAL - Grand Totals
; LINE1 - 131 '-'s
; RCDISP - 1 - Output to Excel, 0 otherwise
; Output: RCSTOP - 1 if display aborted, 0 otherwise
I 'RCDISP,$Y>(IOSL-6) D HDR(.DIVS,.PAYERS) Q:RCSTOP
W !,"GRAND TOTALS FOR ALL DIVISIONS",?90,$J(+$P(GTOTAL,U,2),10,2)
W $J(+$P(GTOTAL,U,3),10,2),$J(+$P(GTOTAL,U,4),10,2)
W $J($P(GTOTAL,U,3)/$P(GTOTAL,U,2)*100,9,2),"%"
W !,?8,"COUNT",?90,$J(+$P(GTOTAL,U),10,0),$J(+$P(GTOTAL,U),10,0),$J(+$P(GTOTAL,U),10,0)
W !,?8,"MEAN",?90,$J($P(GTOTAL,U,2)/$P(GTOTAL,U),10,2)
W $J($P(GTOTAL,U,3)/$P(GTOTAL,U),10,2),$J($P(GTOTAL,U,4)/$P(GTOTAL,U),10,2)
W !,LINE1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAPP 19919 printed Apr 09, 2024@20:49:14 Page 2
RCDPEAPP ;OIFO-BAYPINES/PJH - AUTO POST REPORT ;Dec 20, 2014@18:42
+1 ;;4.5;Accounts Receivable;**298,304,326,345**;Mar 20, 1995;Build 34
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;Read ^DGCR(399) via Private IA 3820
+4 ;Read ^DG(40.8) via Controlled IA 417
+5 ;Read ^IBM(361.1) via Private IA 4051
+6 ;Use DIVISION^VAUTOMA via Controlled IA 664
+7 ; PRCA*4.5*326 - Extensive re-write of this routine to add selection/sort by Payer TIN
RPT ; entry point for Auto-Post Report [RCDPE AUTO-POST REPORT]
+1 NEW POP,RCDISP,RCDIV,RCDIVS,RCDTRNG,RCJOB,RCLAIM,RCPAGE,RCPAR,RCPARRAY,RCPAY,RCPROG,RCRANGE
+2 NEW RCSORT,RCTYPE,RCWHICH,STANAM,STANUM,X,Y
+3 ; Initialize page and start point
SET (RCDTRNG,RCPAGE)=0
SET RCPROG="RCDPEAPP"
SET RCJOB=$JOB
+4 ; Select Filter/Sort by Division
SET RCDIV=$$STADIV(.RCDIVS)
if 'RCDIV
QUIT
+5 ; Detail or Summary mode
SET RCTYPE=$$DETORSUM()
if RCTYPE=-1
QUIT
+6 ;
+7 ; PRCA*4.5*326 - Add Tricare filter to Med/Pharm/Both
SET RCLAIM=$$RTYPE^RCDPEU1()
if RCLAIM=-1
QUIT
+8 ; PRCA*4.5*326 - Filter by Payer Name or TIN
SET RCWHICH=$$NMORTIN()
if RCWHICH=-1
QUIT
+9 ;
+10 ; PRCA*4.5*326 - Selected or Range of Payers
SET RCPAR("SELC")=$$PAYRNG^RCDPEU1(0,1,RCWHICH)
+11 ; PRCA*4.5*326 '^' or timeout
if RCPAR("SELC")=-1
QUIT
+12 SET RCPAY=RCPAR("SELC")
+13 ;
+14 ; PRCA*4.5*326 - Since we don't want all payers
IF RCPAR("SELC")'="A"
Begin DoDot:1
+15 SET RCPAR("TYPE")=RCLAIM
+16 ; prompt for payers we do want
SET RCPAR("SRCH")=$SELECT(RCWHICH=2:"T",1:"N")
+17 SET RCPAR("FILE")=344.4
+18 SET RCPAR("DICA")="Select Insurance Company"_$SELECT(RCWHICH=1:" NAME: ",1:" TIN: ")
+19 SET XX=$$SELPAY^RCDPEU1(.RCPAR)
End DoDot:1
if XX=-1
QUIT
+20 ;
+21 ; Select Sort
SET RCSORT=$$SORTT()
if RCSORT=-1
QUIT
+22 ; Select Date Range for Report
SET RCRANGE=$$DTRNG()
if RCRANGE=0
QUIT
+23 ; Excel not implemented for summary report - PRCA*4.5*345
IF RCTYPE="S"
SET RCDISP=0
+24 ; Output to Excel?
IF '$TEST
SET RCDISP=$$DISPTY()
if RCDISP=-1
QUIT
+25 ; Display capture information for Excel
IF RCDISP
DO INFO^RCDPEM6
+26 ;
+27 IF 'RCDISP
WRITE !,"This report requires 132 column display."
+28 ; Select output device
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+29 ;
+30 ; Option to queue
+31 IF 'RCDISP
IF $DATA(IO("Q"))
Begin DoDot:1
+32 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+33 SET ZTRTN="REPORT^RCDPEAPP"
+34 SET ZTDESC="EDI LOCKBOX AUTO POST REPORT"
+35 ;**FA** ,ZTSAVE("VAUTD")=""
SET ZTSAVE("RC*")=""
+36 ; PRCA*4.5*326
SET ZTSAVE("^TMP(""RCDPEU1"",$J,")=""
+37 DO ^%ZTLOAD
+38 IF $DATA(ZTSK)
WRITE !!,"Task number "_ZTSK_" was queued."
+39 IF '$TEST
WRITE !!,"Unable to queue this job."
+40 KILL IO("Q")
+41 DO HOME^%ZIS
End DoDot:1
QUIT
+42 ;
+43 ; Compile and print report
DO REPORT
+44 QUIT
+45 ;
STADIV(DIVS) ; Division/Station Filter/Sort
+1 ; Input: None
+2 ; Output: DIVS(A1)=A1^A3 Selected Divisions (if not 'ALL') Where:
+3 ; A1 - Division IEN
+4 ; A2 - Division Name
+5 ; A3 - Station Number
+6 ; Returns: -1 - User ^ or timed out
+7 ; 1 - All divisions selected
+8 ; 2 - Selected Divisions
+9 NEW DIR,DIRUT,DIROUT,DIV,DTOUT,DUOUT,STNUM,VAUTD,Y
+10 ; IA 664
DO DIVISION^VAUTOMA
if Y<0
QUIT -1
+11 ; All Divisions selected
IF VAUTD=1
SET RCDIV=1
QUIT 1
+12 KILL DIVS
+13 SET DIV=""
+14 FOR
Begin DoDot:1
+15 SET DIV=$ORDER(VAUTD(DIV))
+16 if DIV=""
QUIT
+17 SET STNUM=$$GET1^DIQ(40.8,DIV,1,"E")
+18 if STNUM=""
SET STNUM="UNKNOWN"
+19 SET DIVS(DIV)=VAUTD(DIV)_"^"_STNUM
End DoDot:1
if DIV=""
QUIT
+20 ; Some Divisions selected
QUIT 2
+21 ;
DETORSUM() ; Ask the user wants to see the detail or summary report
+1 ; Input: None
+2 ; Returns: -1 - User ^ or timed out
+3 ; D - Detail Mode
+4 ; S - Summary Mode
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,XX,Y
+6 SET DIR(0)="SA^S:SUMMARY;D:DETAIL;"
SET DIR("A")="Display (S)UMMARY or (D)ETAIL Format?: "
+7 SET DIR("B")="DETAIL"
+8 SET XX="Select 'SUMMARY' to see the summary report or "
+9 SET DIR("?")=XX_"'DETAIL' to see the detail report"
+10 DO ^DIR
+11 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+12 QUIT Y
+13 ;
NMORTIN() ; EP - Ask the user if they want to filter by Payer Name or TIN
+1 ; Input: None
+2 ; Returns: -1 - User ^ or timed out
+3 ; 1 - Filter by Payer Name
+4 ; 2 - Filter by Payer TIN
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DIR(0)="SA^N:NAME;T:TIN;"
+7 SET DIR("A")="Select Insurance Companies by NAME or TIN: "
+8 SET DIR("B")="TIN"
+9 SET DIR("?")="Select 'NAME' to select Payers by name or 'TIN' to select Payers by TIN"
+10 DO ^DIR
+11 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+12 if Y="N"
QUIT 1
+13 QUIT 2
+14 ;
SELPAY(RCJOB,RCPARRAY) ; Move ^TMP("RCSELPAY",RCJOB) into RCPARRAY for lookup
+1 ; note that payer names for 344.4 are UPPER CASE
+2 ; Input: RCJOB - $J
+3 ; ^TMP("RCSELPAY",RCJOB,) - Temp array of selected Payers
+4 ; Output: RCPARRAY(A1,A2)=A3 - Array of selected Payers Where:
+5 ; A1 - Payer Name or TIN based on the way ^TMP("RCSELPAY" was built
+6 ; A2 - Counter
+7 ; A3 - Payer Name/TIN or TIN/Payer Name based on the way ^TMP("RCSELPAY" was built
+8 NEW PAYER,PSUB
+9 SET PSUB=0
+10 FOR
SET PSUB=$ORDER(^TMP("RCSELPAY",RCJOB,PSUB))
if 'PSUB
QUIT
Begin DoDot:1
+11 SET PAYER=$GET(^TMP("RCSELPAY",RCJOB,PSUB))
+12 if PAYER'=""
SET RCPARRAY($PIECE(PAYER,"/",1),PSUB)=PAYER
End DoDot:1
+13 QUIT
+14 ;
SORTT() ; Ask the user if they want to sort by Payer Name or Payer TIN
+1 ; Input: None
+2 ; Returns: -1 - User ^ or timed out
+3 ; 0 - Sort by Payer Name
+4 ; 1 - Sort by Payer TIN
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DIR(0)="SA^N:NAME;T:TIN;"
+7 SET DIR("A")="Sort by Insurance Company NAME or TIN: "
+8 SET DIR("B")="TIN"
+9 SET DIR("?",1)="Select 'NAME' to sort by Division/Payer Name or"
+10 SET DIR("?")="select 'TIN' to sort by Division/Payer TIN"
+11 DO ^DIR
+12 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+13 if Y="N"
QUIT 0
+14 QUIT 1
+15 ;
DTRNG() ; Get the date range for the report
+1 ; Input: None
+2 ; Returns: 0 - User ^ or timed out
+3 ; 1^Start Date^End Date
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCEND,RNGFLG,RCSTART,X,Y
+5 DO DATES(.RCSTART,.RCEND)
+6 if RCSTART=-1
QUIT 0
+7 if RCSTART
QUIT "1^"_RCSTART_"^"_RCEND
+8 if 'RCSTART
QUIT "0^^"
+9 QUIT 0
+10 ;
DISPTY() ; Get display/output type
+1 ; Input: None
+2 ; Return:: -1 - User ^ or timed out
+3 ; 0 - Not to Excel
+4 ; 1 - Output to Excel
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+6 SET DIR(0)="Y"
+7 SET DIR("A")="Export the report to Microsoft Excel"
+8 SET DIR("B")="NO"
+9 DO ^DIR
+10 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+11 QUIT Y
+12 ;
DATES(BDATE,EDATE) ; Get a date range.
+1 ; Input: None
+2 ; Output: BDATE - Internal Begin date
+3 ; EDATE - Internal End date
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 SET (BDATE,EDATE)=0
+6 SET DIR("?")="Enter the earliest Auto-Posting date to include on the report"
+7 SET DIR(0)="DAO^:"_DT_":APE"
SET DIR("A")="Start Date: "
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET BDATE=-1
QUIT
+10 SET BDATE=Y
+11 SET DIR("?")="Enter the latest Auto-Posting date to include on the report"
+12 SET DIR("B")=Y(0)
+13 SET DIR(0)="DAO^"_BDATE_":"_DT_":APE"
SET DIR("A")="End Date: "
+14 DO ^DIR
KILL DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET BDATE=-1
QUIT
+16 SET EDATE=Y
+17 QUIT
+18 ;
REPORT ; Compile and print report
+1 ; Input: RCDISP - 0 - Output to paper or screen, 1 - Output to Excel
+2 ; RCDIV - 1 - All divisions, 2 - Selected divisions
+3 ; RCDIVS()- Array of selected divisions if RCDIV=2
+4 ; RCRANGE - 1^Start Date^End Date
+5 ; RCJOB - $J
+6 ; RCLAIM - "M" - Medical Claims, "P" - Pharmacy Claims, "B" - Both
+7 ; RCPAGE - Initialized to 0
+8 ; RCPARRAY- Array of selected payers
+9 ; RCPROG - "RCDPEAPP"
+10 ; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
+11 ; RCTYPE - 'D' for detail report, 'S' for summary
+12 ; RCWHICH - 1 - Filter by Payer Name, 2 - Filter by Payer TIN
+13 ; ^TMP("RCDPEU1",$J) - Selected payerers (see SELPAY^RCDPEU1 for details)
+14 ;
+15 NEW GLOB,GTOTAL,ZTREQ
+16 KILL ^TMP(RCPROG,$JOB),^TMP("RCDPEAPP2",$JOB)
+17 SET GLOB=$NAME(^TMP(RCPROG,$JOB))
+18 ; Scan ERA file for entries in date range
DO COMPILE^RCDPEAPQ
+19 ; Display the Report
DO DISP
+20 ;
+21 ; Clear ^TMP global
+22 ; PRCA*4.5*326
KILL ^TMP(RCPROG,$JOB),^TMP("RCSELPAY",RCJOB),^TMP("RCDPEAPP2",$JOB),^TMP("RCDPEU1",$JOB)
+23 QUIT
+24 ;
DISP ; Format the display for screen/printer or MS Excel
+1 ; Input: GLOB - "^TMP("RCDPEAPP",$J)
+2 ; RCDISP - 1 - Output to Excel, 0 otherwise
+3 ; RCDIV - 1 - All Divisions selected
+4 ; RCDIVS - Array of selected Divisions (if all not selected)
+5 ; RCPARRAY- Array of selected Payers
+6 ; RCPAY - 1 - All Payers selected
+7 NEW DIVS,LINE1,LINE2,PAYERS,RCDATA,RCHDRDT,RCSTOP,SUB,SUB1,SUB2,SUB3
+8 ; Date/time for header
SET RCHDRDT=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ")
+9 SET LINE1=$TRANSLATE($JUSTIFY("",131)," ","-")
SET LINE2=$TRANSLATE(LINE1,"-","=")
+10 USE IO
+11 ;
+12 ; Report by division or 'ALL'
+13 ; Format Division filter
DO LINED(RCDIV,.RCDIVS,.DIVS)
+14 ; Format Payer filter
DO LINEP(RCPAY,.RCPARRAY,RCWHICH,.PAYERS)
+15 SET SUB=""
SET RCSTOP=0
+16 ; Single header for Excel
IF RCDISP
DO HDR(.DIVS,.PAYERS)
+17 ; PRCA*4.5*345 Loop for Detail report
IF RCTYPE="D"
FOR
SET SUB=$ORDER(@GLOB@(SUB))
if SUB=""
QUIT
Begin DoDot:1
+18 IF 'RCDISP
Begin DoDot:2
+19 ; Display Header
DO HDR(.DIVS,.PAYERS)
+20 WRITE !,"DIVISION: ",SUB
End DoDot:2
+21 ; Division
SET SUB1=""
+22 FOR
SET SUB1=$ORDER(@GLOB@(SUB,SUB1))
if SUB1=""
QUIT
Begin DoDot:2
+23 SET SUB2=""
+24 FOR
SET SUB2=$ORDER(@GLOB@(SUB,SUB1,SUB2))
if SUB2=""
QUIT
Begin DoDot:3
+25 ;
+26 ; Display payer sub-header for detail report only
+27 IF 'RCDISP
IF RCTYPE="D"
DO HDRP(SUB1_"/"_SUB2)
+28 SET SUB3=""
+29 FOR
SET SUB3=$ORDER(@GLOB@(SUB,SUB1,SUB2,SUB3))
if SUB3=""
QUIT
Begin DoDot:4
+30 SET RCDATA=@GLOB@(SUB,SUB1,SUB2,SUB3)
+31 IF 'RCDISP
Begin DoDot:5
+32 IF $Y>(IOSL-6)
DO HDR(.DIVS,.PAYERS)
if RCSTOP
QUIT
+33 ; Patient Name
WRITE !,$PIECE(RCDATA,U,4)
+34 ; ERA#
WRITE ?31,$PIECE(RCDATA,U,5)
+35 ; Date Received
WRITE ?38,$PIECE(RCDATA,U,6)
+36 ; Date Autposted
WRITE ?49,$PIECE(RCDATA,U,7)
+37 ; EFT#
WRITE ?58,$PIECE(RCDATA,U,8)
+38 ; "TR" Receipt
WRITE ?67,$PIECE(RCDATA,U,9)
+39 ; Bill #
WRITE ?79,$EXTRACT($PIECE(RCDATA,U,10),1,12)
+40 ; PRCA*4.5*345 - Begin modified code block
+41 ; Original Billed Amount
WRITE ?90,$JUSTIFY($PIECE(RCDATA,U,11),10,2)
+42 ; Paid Amount
WRITE $JUSTIFY($PIECE(RCDATA,U,12),10,2)
+43 ; Balance
WRITE $JUSTIFY($PIECE(RCDATA,U,13),10,2)
+44 ; % COLLECTED
WRITE $JUSTIFY($PIECE(RCDATA,U,14),10,2)
+45 ; Deposit #
WRITE !,?8,"DEP#:",$PIECE(RCDATA,U,16)
+46 ; Trace #
WRITE ?25,"TRACE#:",$PIECE(RCDATA,U,15)
+47 ; PRCA*4.5*345 - End modified code block
+48 ;
+49 ; Subtotals for Payer on detail report
+50 IF 'RCDISP
IF $ORDER(@GLOB@(SUB,SUB1,SUB2,SUB3))=""
DO TOTALDP(SUB,SUB1,SUB2)
End DoDot:5
if RCSTOP
QUIT
+51 IF RCDISP
Begin DoDot:5
+52 ;
IF $LENGTH(RCDATA)>255
Begin DoDot:6
+53 NEW RCPAY,RCTIN
+54 SET RCPAY=$PIECE(RCDATA,"^",3)
+55 SET RCTIN=$PIECE(RCPAY,"/",$SELECT(RCSORT=0:2,1:1))
+56 SET RCPAY=$PIECE(RCPAY,"/",$SELECT(RCSORT=0:1,1:2))
+57 SET RCPAY=$EXTRACT(RCPAY,1,$LENGTH(RCPAY)-($LENGTH(RCDATA)-255))
+58 SET RCPAY=$SELECT(RCSORT=0:RCPAY_"/"_RCTIN,1:RCTIN_"/"_RCPAY)
+59 SET $PIECE(RCDATA,"^",3)=RCPAY
End DoDot:6
+60 WRITE !,RCDATA
End DoDot:5
End DoDot:4
if RCSTOP
QUIT
+61 ;
+62 ; Subtotals for Division on detail report
+63 IF 'RCDISP
IF RCTYPE="D"
IF $ORDER(@GLOB@(SUB,SUB1))=""
DO TOTALD(SUB)
End DoDot:3
if RCSTOP
QUIT
End DoDot:2
if RCSTOP
QUIT
End DoDot:1
if RCSTOP
QUIT
+64 ;
+65 ; Grand totals
+66 IF $DATA(GTOTAL)
IF 'RCSTOP
Begin DoDot:1
+67 ; Print grand only total if detail report
IF 'RCDISP
IF RCTYPE="D"
DO TOTALG
+68 ; Print all totals if summary report
IF 'RCDISP
IF RCTYPE="S"
DO TOTALS
+69 WRITE !,$$ENDORPRT^RCDPEARL
if '$GET(ZTSK)
DO ASK(.RCSTOP)
End DoDot:1
+70 ;
+71 ; Null Report
IF '$DATA(GTOTAL)
Begin DoDot:1
+72 DO HDR(.DIVS,.PAYERS)
+73 WRITE !!,?26,"*** NO RECORDS TO PRINT ***",!
+74 ; PRCA*4.5*326
WRITE !,$$ENDORPRT^RCDPEARL
if '$GET(ZTSK)
DO ASK(.RCSTOP)
End DoDot:1
+75 ;
+76 ; Close device
+77 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+78 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+79 QUIT
+80 ;
ASK(STOP) ; Ask to continue
+1 ; Output: STOP - 1 if display is aborted
+2 ; Not displaying to screen, quit
IF $EXTRACT(IOST,1,2)'["C-"
QUIT
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+4 SET DIR("A")="Press ENTER to continue: "
+5 SET DIR(0)="EA"
+6 DO ^DIR
+7 IF ($DATA(DIRUT))!($DATA(DUOUT))
SET STOP=1
+8 QUIT
+9 ;
HDR(DIVS,PAYERS) ; Print the report header
+1 ; Input: DIVS() - Array of selected Division lines for Header
+2 ; PAYERS() - Array of selected Payer lines for Header
+3 ; RCDISP - 1 - Output to Excel, 0 otherwise
+4 ; RCHDRDT - External Print Date/Tim
+5 ; RCPAGE - Current Page number
+6 ; RCRANGE - Selected Date Range
+7 ; RCSORT - 0 - Sort by Payer Name, 1 - Sort by Payer TIN
+8 ; RCSTOP - 1 if display aborted
+9 ; Output: RCPAGE - Updated Page Number
+10 ; RCSTOP - 1 if display aborted
+11 NEW END,LN,MSG,START,XX,Y
+12 if RCSTOP
QUIT
+13 ; Output to Excel
IF RCDISP
Begin DoDot:1
+14 SET XX="STATION^STATION NUMBER^PAYER^PATIENT NAME/SSN^ERA#^DT REC'D"
+15 SET XX=XX_"^DT POST^EFT#^RECEIPT#^BILL#^AMT BILLED^AMT PAID^BALANCE^%COLL^TRACE#^DEPOSIT#"
+16 WRITE !,XX
End DoDot:1
QUIT
+17 SET START=$$FMTE^XLFDT($PIECE(RCRANGE,U,2),"2DZ")
+18 SET END=$$FMTE^XLFDT($PIECE(RCRANGE,U,3),"2DZ")
+19 IF RCPAGE
DO ASK(.RCSTOP)
if RCSTOP
QUIT
+20 SET RCPAGE=RCPAGE+1
+21 WRITE @IOF
+22 SET MSG(1)="EDI LOCKBOX AUTO-POST REPORT - "_$SELECT(RCTYPE="D":"DETAIL ",1:"SUMMARY")
+23 SET MSG(1)=MSG(1)_$JUSTIFY("",47)_"Print Date: "_RCHDRDT_" Page: "_RCPAGE
+24 ;
+25 SET LN=2
SET XX=""
+26 ; Display Division filters
FOR
Begin DoDot:1
+27 SET XX=$ORDER(DIVS(XX))
+28 if XX=""
QUIT
+29 SET MSG(LN)=DIVS(XX)
SET LN=LN+1
End DoDot:1
if XX=""
QUIT
+30 ;
+31 SET MSG(LN)="CLAIM TYPE: "
+32 SET MSG(LN)=MSG(LN)_$SELECT(RCLAIM="P":"PHARMACY",RCLAIM="M":"MEDICAL",RCLAIM="T":"TRICARE",1:"ALL")
+33 ; PRCA*4.5*326
SET MSG(LN)=MSG(LN)_$JUSTIFY("",55-$LENGTH(MSG(LN)))_"SORTED BY: "_$SELECT(RCSORT=0:"PAYER NAME",1:"PAYER TIN")
+34 SET LN=LN+1
+35 ; PRCA*4.5*326
SET MSG(LN)=$SELECT(RCWHICH=2:"TINS",1:"PAYERS")_" : "_$SELECT(RCPAY="S":"SELECTED",RCPAY="R":"RANGE",1:"ALL")
+36 SET LN=LN+1
+37 SET MSG(LN)="AUTOPOST POSTING RESULTS FOR DATE RANGE: "_START_" - "_END
+38 SET LN=LN+1
SET MSG(LN)=LINE2
+39 SET LN=LN+1
+40 ;
IF RCTYPE="D"
Begin DoDot:1
+41 SET MSG(LN)="PATIENT NAME/SSN ERA# DT REC'D DT POST EFT# RECEIPT# BILL#"
End DoDot:1
+42 IF '$TEST
SET MSG(LN)=" "
+43 SET MSG(LN)=MSG(LN)_" AMT BILLED AMT PAID BALANCE %COLL"
+44 SET LN=LN+1
SET MSG(LN)=LINE2
+45 DO EN^DDIOL(.MSG)
+46 QUIT
+47 ;
HDRP(PAYNAM) ; Print Payer Sub-header
+1 ; Input: LINE1 - 131 '-'s
+2 ; PAYNAM - TIN/Payer Name or Payer NAME/TIN depending on sort
+3 WRITE !,LINE1,!,"PAYER: ",PAYNAM,!,LINE1
+4 QUIT
+5 ;
LINED(RCDIV,RCDIVS,DIVS) ; List selected Divisions
+1 ; Input: RCDIV - 1 - All Divisions Selected,
+2 ; RCDIVS()- Array of selected Divisions
+3 ; Output DIVS() - Array of lines to print the Divisions
+4 ; Returns: Comma Delimitted list of Divisions
+5 NEW LN,SUB,XX
+6 KILL DIVS
+7 SET SUB=""
SET LN=1
SET DIVS(1)="DIVISIONS: "
+8 IF RCDIV=1
SET DIVS(1)=DIVS(1)_"ALL"
QUIT
+9 FOR
Begin DoDot:1
+10 SET SUB=$ORDER(RCDIVS(SUB))
+11 if 'SUB
QUIT
+12 SET XX=$PIECE(RCDIVS(SUB),"^",2)
+13 IF $LENGTH(XX)+$LENGTH(DIVS(LN))+2>132
Begin DoDot:2
+14 SET LN=LN+1
SET DIVS(LN)=" "_XX
End DoDot:2
+15 IF '$TEST
SET DIVS(LN)=$SELECT($LENGTH(DIVS(LN))=12:DIVS(LN)_XX,1:DIVS(LN)_", "_XX)
End DoDot:1
if 'SUB
QUIT
+16 QUIT
+17 ;
LINEP(RCPAY,RCPARRAY,RCWHICH,PAYERS) ; List selected Payers
+1 ; Input: RCPAY - 2 - All Payers selected
+2 ; RCPARRAY - Array of selected Payers
+3 ; RCWHICH - 1 - Filter by Payer Name, 2 - Filter by Payer TIN
+4 ; Output: PAYERS() - Array of lines to Print the Payers
+5 ; Returns: Comma delimited list of Payer Names
+6 NEW CTR,DPAYS,LN,PAYR,PCE,XX
+7 KILL PAYERS
+8 SET PAYR=""
SET LN=1
SET PAYERS(1)="PAYERS: "
+9 SET PCE=$SELECT(RCWHICH=1:2,1:1)
+10 IF $PIECE(RCPAY,U,1)=2
SET PAYERS(1)=PAYERS(1)_"ALL"
QUIT
+11 FOR
Begin DoDot:1
+12 SET PAYR=$ORDER(RCPARRAY(PAYR))
+13 if PAYR=""
QUIT
+14 SET CTR=""
+15 FOR
Begin DoDot:2
+16 SET CTR=$ORDER(RCPARRAY(PAYR,CTR))
+17 if CTR=""
QUIT
+18 ; Payer TIN
SET XX=$PIECE(RCPARRAY(PAYR,CTR),"/",PCE)
+19 ; Already displayed
if $DATA(DPAYS(XX))
QUIT
+20 SET DPAYS(XX)=""
+21 IF $LENGTH(XX)+$LENGTH(PAYERS(LN))+2>132
Begin DoDot:3
+22 SET LN=LN+1
SET PAYERS(LN)=" "_XX
End DoDot:3
+23 IF '$TEST
SET PAYERS(LN)=$SELECT($LENGTH(PAYERS(LN))=12:PAYERS(LN)_XX,1:PAYERS(LN)_", "_XX)
End DoDot:2
if CTR=""
QUIT
End DoDot:1
if PAYR=""
QUIT
+24 QUIT
+25 ;
TOTALS ; Print totals for summary report
+1 ; Input: GLOB - "^TMP("RCPDEAPP",$J)
+2 NEW DBAL,DBAMT,DCNT,DIV,DPAMT,PAYIX1,PAYIX2
+3 SET DIV=""
+4 FOR
Begin DoDot:1
+5 SET DIV=$ORDER(@GLOB@(DIV))
+6 if DIV=""
QUIT
+7 ; PRCA*4.5*345 Display header
DO HDR(.DIVS,.PAYERS)
+8 ; PRCA*4.5*345 Display division
WRITE !,"DIVISION: ",DIV,!,LINE1
+9 SET PAYIX1=""
+10 FOR
Begin DoDot:2
+11 SET PAYIX1=$ORDER(@GLOB@(DIV,PAYIX1))
+12 if PAYIX1=""
QUIT
+13 SET PAYIX2=""
+14 FOR
Begin DoDot:3
+15 SET PAYIX2=$ORDER(@GLOB@(DIV,PAYIX1,PAYIX2))
+16 if PAYIX2=""
QUIT
+17 ; Payer Totals
DO TOTALDP(DIV,PAYIX1,PAYIX2)
End DoDot:3
if PAYIX2=""
QUIT
if RCSTOP
QUIT
End DoDot:2
if PAYIX1=""
QUIT
if RCSTOP
QUIT
+18 ; Division Totals
DO TOTALD(DIV)
End DoDot:1
if DIV=""
QUIT
if RCSTOP
QUIT
+19 ; Grand Totals
DO TOTALG
+20 QUIT
+21 ;
TOTALD(DIV) ; Display totals for a division
+1 ; Input: DIV - Division Name
+2 ; DIVS() - Array of selected Division lines for Header
+3 ; PAYERS()- Array of selected Payer lines for Header
+4 ; GLOB - "^TMP("RCPDEAPP",$J)
+5 ; LINE1 - 131 '-'s
+6 ; RCDISP - 1 - Output to Excel, 0 otherwise
+7 ; Output: RCSTOP - 1 if display aborted, 0 otherwise
+8 NEW DBAL,DBAMT,DCNT,DPAMTL
+9 SET DCNT=$PIECE(@GLOB@(DIV),U)
SET DBAMT=$PIECE(@GLOB@(DIV),U,2)
+10 SET DPAMT=$PIECE(@GLOB@(DIV),U,3)
SET DBAL=$PIECE(@GLOB@(DIV),U,4)
+11 IF 'RCDISP
IF $Y>(IOSL-6)
DO HDR(.DIVS,.PAYERS)
if RCSTOP
QUIT
+12 WRITE !,"DIVISION TOTALS FOR ",DIV,?90,$JUSTIFY(DBAMT,10,2)
+13 WRITE $JUSTIFY(DPAMT,10,2),$JUSTIFY(DBAL,10,2)
+14 if DBAMT'=0
WRITE $JUSTIFY(DPAMT/DBAMT*100,10,2),"%"
+15 WRITE !,?8,"COUNT",?90,$JUSTIFY(DCNT,10,0),$JUSTIFY(DCNT,10,0),$JUSTIFY(DCNT,10,0)
+16 WRITE !,?8,"MEAN",?90,$JUSTIFY(DBAMT/DCNT,10,2),$JUSTIFY(DPAMT/DCNT,10,2),$JUSTIFY(DBAL/DCNT,10,2)
+17 WRITE !,LINE1
+18 QUIT
+19 ;
TOTALDP(DIV,PAYIX1,PAYIX2) ; Display totals for a payer within a division
+1 ; Input: DIV - Division Name
+2 ; PAYIX1 - Payer Name OR TIN
+3 ; PAYIX2 - TIN OR Payer Name
+4 ; DIVS() - Array of selected Division lines for Header
+5 ; GLOB - "^TMP("RCPDEAPP",$J)
+6 ; LINE1 - 131 '-'s
+7 ; PAYERS()- Array of selected Payer lines for Header
+8 ; RCDISP - 1 - Output to Excel, 0 otherwise
+9 ; Output: RCSTOP - 1 if display aborted, 0 otherwise
+10 NEW DATA,DBAL,DBAMT,DCNT,DPAMT
+11 IF 'RCDISP
IF $Y>(IOSL-6)
DO HDR(.DIVS,.PAYERS)
if RCSTOP
QUIT
+12 ; PRCA*4.5*345 Correct totals by payer
SET DATA=@GLOB@(DIV,PAYIX1,PAYIX2)
+13 ; PRCA*4.5*345
SET DCNT=$PIECE(DATA,U)
SET DBAMT=$PIECE(DATA,U,2)
+14 ; PRCA*4.5*345
SET DPAMT=$PIECE(DATA,U,3)
SET DBAL=$PIECE(DATA,U,4)
+15 if RCTYPE="D"
WRITE !,?90,"-----------------------------------------"
+16 WRITE !,"SUBTOTALS FOR PAYER: ",PAYIX1,"/",PAYIX2,?90,$JUSTIFY(DBAMT,10,2),$JUSTIFY(DPAMT,10,2)
+17 WRITE $JUSTIFY(DBAL,10,2)
+18 if DBAMT'=0
WRITE $JUSTIFY(DPAMT/DBAMT*100,10,2),"%"
+19 WRITE !,?8,"COUNT",?90,$JUSTIFY(DCNT,10,0),$JUSTIFY(DCNT,10,0),$JUSTIFY(DCNT,10,0)
+20 WRITE !,?8,"MEAN",?90,$JUSTIFY(DBAMT/DCNT,10,2),$JUSTIFY(DPAMT/DCNT,10,2),$JUSTIFY(DBAL/DCNT,10,2)
+21 WRITE !,LINE1
+22 QUIT
+23 ;
TOTALG ;Display overall report total
+1 ; Input: DIVS() - Array of selected Division lines for Header
+2 ; PAYERS()- Array of selected Payer lines for Header
+3 ; GTOTAL - Grand Totals
+4 ; LINE1 - 131 '-'s
+5 ; RCDISP - 1 - Output to Excel, 0 otherwise
+6 ; Output: RCSTOP - 1 if display aborted, 0 otherwise
+7 IF 'RCDISP
IF $Y>(IOSL-6)
DO HDR(.DIVS,.PAYERS)
if RCSTOP
QUIT
+8 WRITE !,"GRAND TOTALS FOR ALL DIVISIONS",?90,$JUSTIFY(+$PIECE(GTOTAL,U,2),10,2)
+9 WRITE $JUSTIFY(+$PIECE(GTOTAL,U,3),10,2),$JUSTIFY(+$PIECE(GTOTAL,U,4),10,2)
+10 WRITE $JUSTIFY($PIECE(GTOTAL,U,3)/$PIECE(GTOTAL,U,2)*100,9,2),"%"
+11 WRITE !,?8,"COUNT",?90,$JUSTIFY(+$PIECE(GTOTAL,U),10,0),$JUSTIFY(+$PIECE(GTOTAL,U),10,0),$JUSTIFY(+$PIECE(GTOTAL,U),10,0)
+12 WRITE !,?8,"MEAN",?90,$JUSTIFY($PIECE(GTOTAL,U,2)/$PIECE(GTOTAL,U),10,2)
+13 WRITE $JUSTIFY($PIECE(GTOTAL,U,3)/$PIECE(GTOTAL,U),10,2),$JUSTIFY($PIECE(GTOTAL,U,4)/$PIECE(GTOTAL,U),10,2)
+14 WRITE !,LINE1
+15 QUIT
