RCDPEFA3 ;AITC/CJE - 1ST PARTY AUTO DECREASE VS MANUAL DECREASE REPORT;Jun 06, 2014@19:11:19 ; 7/3/19 8:41am
;;4.5;Accounts Receivable;**345,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
;
EN ; Entry point for Manual vs Auto-Decrease Adjustment Report [RCDPE FIRST PARTY MANUAL VS AUTO]
N INPUT,RCVAUTD
S INPUT=$$STADIV^RCDPEFA2(.RCVAUTD) ; Division filter
Q:'INPUT
S $P(INPUT,U,2)=$$DETSUM^RCDPEFA2 ; Display detailed or summary report
Q:$P(INPUT,U,2)=0 ; '^' or timeout
S $P(INPUT,U,3)="F"
I $P(INPUT,U,2)="D" D ; Select Sort Criteria
. S $P(INPUT,U,3)=$$SORTORD^RCDPEFA2("C")
Q:$P(INPUT,U,3)=0 ; '^' or timeout
W !!,"Include first party bills where the latest decrease falls within the following"
W !,"date range",!
S $P(INPUT,U,4)=$$DTRNG^RCDPEFA2 ; Select Date Range for Report
Q:'$P(INPUT,U,4) ; '^' or timeout
S $P(INPUT,U,4)=$P($P(INPUT,U,4),"|",2,3)
S $P(INPUT,U,5)=$$ASKLM^RCDPEARL ; Ask to Display in Listman Template
Q:$P(INPUT,U,5)<0 ; '^' or timeout
I $P(INPUT,U,5)=1 D Q ; Compile data and call listman to display
. D LMOUT^RCDPEFA4(INPUT,.RCVAUTD,.IO)
I $P(INPUT,U,2)="D" D ;
. S $P(INPUT,U,6)=$$DISPTY^RCDPEFA2 ; Select Display Type
Q:$P(INPUT,U,6)=-1 ; '^' or timeout
D:$P(INPUT,U,6)=1 INFO^RCDPEM6 ; Display capture information for Excel
Q:'$$DEVICE^RCDPEFA2(.IO) ; Ask output device
;
; Compile and Display Report data (queued) - not allowed for EXCEL
I $P(INPUT,U,5)'=1,$D(IO("Q")) D Q
. N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
. S ZTRTN="REPORT^RCDPEFA3(INPUT,.RCVAUTD,.IO)"
. S ZTDESC="EDI LOCKBOX FIRST PARTY AUTO-DECREASE REPORT"
. S ZTSAVE("RC*")="",ZTSAVE("INPUT")="",ZTSAVE("IO*")=""
. D ^%ZTLOAD
. W !!,$S($G(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
. K IO("Q") D HOME^%ZIS
D REPORT(INPUT,.RCVAUTD,.IO) ; Create report
;
K ^TMP("RCDPEFADP3",$J),^TMP("RCDPE_ADP3",$J) ; Clear ^TMP global
Q
;
REPORT(INPUTS,RCVAUTD,IO) ; Compile and print report
; Input: INPUTS - A1^A2^A3^...^An Where:
; A1 - 1 - All divisions selected, 2 - Selected divisions
; A2 - D - Detail Report, S - Summary Report
; A3 - F - sort First to Last, L - sort Last to First
; A4 - B1|B2
; B1 - Decrease Transaction Date Entered Start
; B2 - Decrease Transaction Date Entered End
; A5 - 1 - Output to List Manager, else 0
; A6 - 1 - Output to Excel, else 0
; RCVAUTD - Array of selected Divisions, Only passed if A1=2
; IO - Output Device
N RCTOTAL,XX,ZTREQ
U:$P(INPUTS,"^",5)'=1 IO ; PRCA*4.5*349 Added check to skip if in listman mode
K ^TMP("RCDPEFADP3",$J),^TMP("RCDPE_ADP3",$J)
D COMPILE(INPUTS,.RCVAUTD) ; Scan AR TRANSACTION file for entries in date range
D DISP(INPUTS) ; Display Report
D ^%ZISC ; Close device
Q
;
COMPILE(INPUTS,RCVAUTD) ; Compile Report Data
N BEG,DAIEN,END,EXCEL,RC430IEN,RCAMT,RCBILL,RCBILL3,RCCOPAY,RCDT
N RCSITE,RCSORT,RCTR,RCTRAND,RCUSER,STNAM,STNUM,TRANDA,X,XX
;
S XX=$P(INPUTS,U,4) ; Auto-Post Date range
S BEG=$$FMADD^XLFDT($P(XX,"|",1),-1)
S END=$P(XX,"|",2) ; Auto-Post End Date
S RCTR=0 ; Record counter
S EXCEL=$P(INPUTS,U,6) ; 1 output to Excel, 0 otherwise
S RCSORT=$P(INPUTS,U,2) ; Sort Type
;
; Scan index for auto-posted claim lines within the ERA
; and Save claim line detail to ^TMP global
; Get IEN of 'DECREASE ADJUSTMENT' fron #430.3
S DAIEN=$O(^PRCA(430.3,"B","DECREASE ADJUSTMENT",""))
;
; Scan AR Transaction date index for days
S RCTRAND=BEG
F S RCTRAND=$O(^PRCA(433,"AT",DAIEN,RCTRAND)) Q:'RCTRAND!(RCTRAND>END) D
. ;
. ; Scan AR transactions
. S TRANDA=""
. F S TRANDA=$O(^PRCA(433,"AT",DAIEN,RCTRAND,TRANDA)) Q:'TRANDA D
. . S RC430IEN=$$GET1^DIQ(433,TRANDA_",",.03,"I") ; Get AR ACCOUNT
. . Q:'RC430IEN
. . S RCSITE=$$GET1^DIQ(430,RC430IEN_",",12,"I") ; Get SITE ien
. . Q:'RCSITE
. . ;
. . ; Ignore transaction if not a selected Division
. . I $P(INPUTS,U,1)=2,'$D(RCVAUTD(RCSITE)) Q
. . S RCBILL=$$GET1^DIQ(433,TRANDA_",",.03,"I") ; Copay Claim #
. . ; Make sure this is first party - DEBTOR is a patient
. . Q:$$GET1^DIQ(340,$$GET1^DIQ(430,RC430IEN_",",9,"I")_",",.01,"I")'["DPT"
. . I $D(^TMP("RCDPEFADP3",$J,"BILL",RCBILL)) Q ; Bill already stored
. . ; Check that the last decrease falls in the date range, if so store the results
. . D CHKBILL(RCBILL,BEG,END,.RCTR)
;
Q
;
CHKBILL(RCBILL,BEG,END,RCTR) ; Check date of last decrease transaction, store if inside date range.
; Input: RCBILL - Internal entry number to file 430.
; BEG - Beginning date range -1 day, FileMan format
; END - Ending date range, FileMan format
; RCTR - Record counter passed by reference
;
N RCAMT,RCBILL3,RCCOPAY,RCDTI,RCPROC,RCTLIS,RCTOT,RCUSER,RELEASE,STNUM,STNAME,TRANDA,X,Y
S (TRANDA,RCDTI)=""
F X="A","M","T" S RCTOT(X)=0
F S TRANDA=$O(^PRCA(433,"C",RCBILL,TRANDA)) Q:'TRANDA D ;
. I $$GET1^DIQ(433,TRANDA_",",12,"E")'="DECREASE ADJUSTMENT" Q ;
. S X=$$GET1^DIQ(433,TRANDA_",",11,"I")
. I X>RCDTI S RCDTI=X
. S RCTLIS(TRANDA)=""
;
; Is last decrease inside selected date range? If not quit.
I RCDTI'>BEG!(RCDTI>END) Q
;
S RCBILL3=" "
D DIV^RCDPEFA1(RCBILL,.STNUM,.STNAM) ; Station name/number
S X=$$GET1^DIQ(430,RCBILL_",",.01,"E")
S XX=$O(^IB("ABIL",X,0)) ; IEN in file #350
I $$GET1^DIQ(350,XX_",",.05,"E")'="BILLED" Q ; Ignore decrease for charges that were cancelled etc.
S RCCOPAY=$$GET1^DIQ(350,XX_",",.07,"E") ; Copay Amount
S RCPROC=$$GET1^DIQ(430,RCBILL_",",97,"E") ; Processed by
S RELEASE=$S(RCPROC="POSTMASTER":1,1:0) ; Auto-release from hold if bill processed by postmaster
;
; Get all decrease transactions for this bill;
S TRANDA=""
F S TRANDA=$O(RCTLIS(TRANDA)) Q:'TRANDA D ;
. S RCUSER=$$GET1^DIQ(433,TRANDA_",",42,"E") ; Get user
. S Y=$$GET1^DIQ(433,TRANDA_",",94,"E")
. I RCBILL3=" ",Y'="" S RCBILL3=Y
. S X=$S(RCUSER="POSTMASTER"&(Y'=" "):"A",1:"M")
. S RCAMT=$$GET1^DIQ(433,TRANDA_",",15,"E") ; Transaction amount
. S RCTOT(X)=$G(RCTOT(X))+RCAMT ; Running total of manual or auto decrease
. S RCTOT("T")=$G(RCTOT("T"))+RCAMT ; Running total decrease for this bill
. ;
;
D SAVE(RCBILL,RCBILL3,RCDTI,RCCOPAY,RELEASE,.RCTOT,.RCTR)
S ^TMP("RCDPEFADP3",$J,"BILL",RCBILL)=""
Q
;
SAVE(RCBILL,RCBILL3,RCDTI,RCCOPAY,RELEASE,RCTOT,RCTR) ; Put data into ^TMP
; Input: RCBILL - Copay Claim #
; RCBILL3 - 3rd Party Claim #
; RCDTI - Auto-decrease date (internal)
; RCCOPAY - Copay Amount
; RELEASE - 1 charge was auto-released from hold, 0 otherwise
; RCTOT - Decrease totals in an array passed by reference
; RCTOT("A") - Auto-decrease total
; RCTOT("M") - Manual decrease total
; RCTOT("T") - Total decrease
; Output: DTOTAL() - RCTR - Record Counter passed by reference
; ^TMP("RCDPEFADP3",$J,A1,A2,A3) = B1^B2^B3^...^Bn Where:
; A1 - "EXCEL" if report to excel, fileman date if not
; A2 - Excel Line Counter if to excel, Claim # if sort by claim,
; A3 - Record Counter
; B1 - External Station Name
; B2 - External Station Number
; B3 - Copay Bill Number
; B4 - 3rd Party Bill Number
; B5 - Auto-Decrease Date
; B6 - Copay Amount
; B7 - Auto-Decrease Amount
; B8 - Manual Decrease Amount
; B9 - Total decrease Amount
; B10 - Auto-release from hold flag
;
N A1,A2,XX,CNT,RCDT,RCTOTAL
S RCTR=RCTR+1
;
S RCDT=$$FMTE^XLFDT(RCDTI,"2SZ") ; Transaction date External
; If EXCEL sorting is done in EXCEL
I EXCEL=1 D
. S A1="EXCEL",A2=$G(^TMP("RCDPEFADP3",$J,A1))+1
. S ^TMP("RCDPEFADP3",$J,A1)=A2
;
; Otherwise sort by DATE and Bill Number
I 'EXCEL D
. S A1=RCDTI
. S A2=RCBILL
;
; Update ^TMP gif claim level adjustments found for this claim
S XX=STNAM_U_STNUM_U_$$GET1^DIQ(430,RCBILL_",",.01,"E")
S XX=XX_U_RCBILL3_U_RCDT_U_RCCOPAY_U_RCTOT("A")_U_RCTOT("M")_U_RCTOT("T")_U_RELEASE
S ^TMP("RCDPEFADP3",$J,"DATA",A1,A2,RCTR)=XX ; Claim Information
;
; Update totals for date
S RCTOTAL=$G(^TMP("RCDPEFADP3",$J,"TOTALS",RCDTI))
S ^TMP("RCDPEFADP3",$J,"TOTALS",RCDTI)=$$TOTAL(RCTOTAL,RCCOPAY,RELEASE,.RCTOT)
;
; Update totals for date range
S RCTOTAL=$G(^TMP("RCDPEFADP3",$J,"TOTALS"))
S ^TMP("RCDPEFADP3",$J,"TOTALS")=$$TOTAL(RCTOTAL,RCCOPAY,RELEASE,.RCTOT)
;
Q
;
TOTAL(RCTOTAL,RCCOPAY,RELEASE,RCTOT) ; Increment daily or overall totals
; Input : RCTOTAL - old total
; : RCCOPAY - COPAY amount
; : RELEASE - Flag 0, 1 if bill was created by auto-releasing a charge from hold
; : RCTOTAL - Array passed by reference of manual, auto and total decreases for this bill
S $P(RCTOTAL,U,1)=$P(RCTOTAL,U,1)+RCCOPAY
S $P(RCTOTAL,U,2)=$P(RCTOTAL,U,2)+RCTOT("A")
S $P(RCTOTAL,U,3)=$P(RCTOTAL,U,3)+RCTOT("M")
S $P(RCTOTAL,U,4)=$P(RCTOTAL,U,4)+RCTOT("T")
S $P(RCTOTAL,U,5)=$P(RCTOTAL,U,5)+$S(RELEASE:1,1:0) ; # of bills created by auto-release from hold
S $P(RCTOTAL,U,6)=$P(RCTOTAL,U,6)+1 ; Total number of bills
Q RCTOTAL
;
DISP(INPUTS) ; Format the display for screen/printer or MS Excel
; Input: INPUTS - See REPORT for details
; ^TMP("RCDPEFADP",$J) - See SAVE for description
N A1,A2,A3,DATA,EXCEL,GTOTAL,HDRINFO,LMAN,LCNT,MODE,PAGE,RCRDNUM,STOP,X,Y,DISP
U:$P(INPUTS,"^",5)'=1 IO ; PRCA*4.5*349 Added check to skip if in listman mode
S EXCEL=$P(INPUTS,U,6),LMAN=$P(INPUTS,U,5),DISP=$P(INPUTS,U,2)
;
; Header information
S XX=$P(INPUTS,U,4) ; Auto-Post Date range
S HDRINFO("START")=$$FMTE^XLFDT($P(XX,"|",1),"2SZ")
S HDRINFO("END")=$$FMTE^XLFDT($P(XX,"|",2),"2SZ")
S HDRINFO("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ")
S HDRINFO("SORT")="Sorted By: Claim"
S XX=$S($P(INPUTS,U,3)="L":"Last to First",1:"First to Last")
S HDRINFO("SORT")=HDRINFO("SORT")_" - "_XX
S HDRINFO("DISP")="Display: "_$S(DISP="S":"Summary",1:"Detail")
;
; Format Division filter
S XX=$P(INPUTS,U,1) ; XX=1 - All Divisions, 2- selected
S HDRINFO("DIVISIONS")=$S(XX=2:$$LINE(.RCVAUTD),1:"ALL")
;
S A1="",PAGE=0,STOP=0,LCNT=1
I 'LMAN,DISP="S" D HDR(EXCEL,.HDRINFO,.PAGE)
S MODE=$S($P(INPUTS,U,3)="L":-1,1:1) ; Mode for $ORDER
F D Q:(A1="")!STOP
. S A1=$O(^TMP("RCDPEFADP3",$J,"DATA",A1))
. Q:A1=""
. I 'LMAN,DISP="D" D Q:STOP ; Display Header
. . I PAGE D ASK^RCDPEFA1(.STOP,0) Q:STOP ; Output to screen, quit if user wants to
. . D HDR(EXCEL,.HDRINFO,.PAGE)
. S A2=""
. F D Q:(A2="")!STOP
. . S A2=$O(^TMP("RCDPEFADP3",$J,"DATA",A1,A2),MODE)
. . I 'EXCEL,A2="" D TOTALD(LMAN,.HDRINFO,.PAGE,.STOP,A1,.LCNT)
. . Q:A2=""
. . Q:DISP="S" ; Skip printing details if summary report
. . S A3=0
. . F D Q:'A3!STOP
. . . S A3=$O(^TMP("RCDPEFADP3",$J,"DATA",A1,A2,A3))
. . . Q:'A3
. . . S DATA=^TMP("RCDPEFADP3",$J,"DATA",A1,A2,A3) ; Auto-Decreased Claim
. . . I EXCEL W !,DATA Q ; Output to Excel
. . . I 'LMAN,$Y>(IOSL-4) D Q:STOP ; End of page
. . . . D ASK^RCDPEFA1(.STOP,0)
. . . . Q:STOP
. . . . D HDR(EXCEL,.HDRINFO,.PAGE)
. . . S Y=$P(DATA,U,3) ; 1st Party Bill
. . . S $E(Y,13)=$P(DATA,U,4) ; 3rd Party Bill
. . . S $E(Y,26)=$P(DATA,U,5) ; Decrease Date
. . . S $E(Y,34)=$J($P(DATA,U,6),7,2) ; Copay AMOUNT
. . . S $E(Y,43)=$J($P(DATA,U,7),7,2) ; Auto-Decrease Amount
. . . S $E(Y,54)=$J($P(DATA,U,8),7,2) ; Manual Decrease Amount
. . . S $E(Y,66)=$J($P(DATA,U,9),7,2) ; Total Decrease Amount
. . . S $E(Y,80)=$S($P(DATA,U,10):"*",1:" ") ; Auto-release flag
. . . I LMAN D
. . . . S ^TMP("RCDPE_ADP3",$J,LCNT)=Y,LCNT=LCNT+1
. . . E D
. . . . W !,Y
;
; Grand totals
S GTOTAL=$P($G(^TMP("RCDPEFADP3",$J,"TOTALS")),"^",6)
I GTOTAL D
. I 'STOP,'EXCEL D ; Print grand total if not Excel
. . D TOTALG(LMAN,.HDRINFO,.PAGE,.STOP,.LCNT)
. I 'EXCEL,'LMAN D ; Report finished
. . W !,$$ENDORPRT^RCDPEARL,!
. . D:'LMAN ASK^RCDPEFA1(.STOP,1)
;
; Null Report
I 'GTOTAL,'LMAN D
. I PAGE=0 D HDR(EXCEL,.HDRINFO,.PAGE)
. W !!,?26,"*** No Records to Print ***",!
. W !,$$ENDORPRT^RCDPEARL
. S:'$D(ZTQUEUED) X=$$ASKSTOP^RCDPELAR
;
; List manager
I LMAN D
. S:LCNT=1 ^TMP("RCDPE_ADP3",$J,LCNT)=$J("",26)_"*** No Records to Print ***",LCNT=LCNT+1
. S ^TMP("RCDPE_ADP3",$J,LCNT)=" ",LCNT=LCNT+1
. S ^TMP("RCDPE_ADP3",$J,LCNT)=$$ENDORPRT^RCDPEARL
; Close device
I '$D(ZTQUEUED) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
LINE(DIV) ; List selected stations
; Input: DIV() - Array of selected divisions
; Returns: Comma delimited list of selected divisions
N LINE,P,SUB
S LINE="",SUB="",P=0
F S SUB=$O(DIV(SUB)) Q:'SUB S P=P+1,$P(LINE,", ",P)=$G(DIV(SUB))
Q LINE
;
TOTALG(LMAN,HDRINFO,PAGE,STOP,LCNT) ;
; Input: LMAN - 1 if output to Listman, 0 otherwise
; HDRINFO - Array of header info
; PAGE - Current Page Number
; LCNT - Current line count (only passedif LMAN=1)
; Output: PAGE - Updated Page Number (if new header is displayed)
; LCNT - Updated line count (only passedif LMAN=1)
N DATA,LN1,LN2
S DATA=^TMP("RCDPEFADP3",$J,"TOTALS")
S LN1=$$TOTALS("**** Totals for Date Range:",DATA)
S LN2=$$PERCENTS(" Percent for Date Range:",DATA)
;
I LMAN D Q
. S ^TMP("RCDPE_ADP3",$J,LCNT)="",LCNT=LCNT+1
. S ^TMP("RCDPE_ADP3",$J,LCNT)=LN1,LCNT=LCNT+1
. S ^TMP("RCDPE_ADP3",$J,LCNT)=LN2,LCNT=LCNT+1
;
I $Y>(IOSL-6) D
. D ASK^RCDPEADP(.STOP,0)
. Q:STOP
. D HDR(EXCEL,.HDRINFO,.PAGE)
Q:STOP
W !!,LN1
W !,LN2,!
Q
;
TOTALD(LMAN,HDRINFO,PAGE,STOP,DAY,LCNT) ; Totals for a single day
; Input: LMAN - 1 if output to List Template, 0 otherwise
; HDRINFO - Array of header information
; PAGE - Page Number
; DAY - FileMan date to display totals for
; LCNT - Current line count (only passedif LMAN=1)
; Output: PAGE - Updated Page Number (if a new header is displayed)
; STOP - 1 if user indiacted to stop
; LCNT - Updated line count (only passedif LMAN=1)
N DAMT,DCNT,LN1,LN2,RCCOPAY,RCDT,Y
S RCDT=$$FMTE^XLFDT(DAY,"2Z")
S DATA=^TMP("RCDPEFADP3",$J,"TOTALS",DAY)
S LN1=$$TOTALS(" **Totals for Date "_RCDT_":",DATA)
S LN2=$$PERCENTS(" Percent for Date "_RCDT_":",DATA)
;
I LMAN D Q
. S ^TMP("RCDPE_ADP3",$J,LCNT)="",LCNT=LCNT+1
. S ^TMP("RCDPE_ADP3",$J,LCNT)=LN1,LCNT=LCNT+1
. S ^TMP("RCDPE_ADP3",$J,LCNT)=LN2,LCNT=LCNT+1
. S ^TMP("RCDPE_ADP3",$J,LCNT)="",LCNT=LCNT+1
;
I $Y>(IOSL-4) D
. D ASK^RCDPEADP(.STOP,0)
. Q:STOP
. D HDR(EXCEL,.HDRINFO,.PAGE)
Q:STOP
W !!,LN1
W !,LN2
Q
;
TOTALS(LABLE,DATA) ; Build Daily or Grand Total string
; Input: LABLE - Text to prepend to totals line
; DATA - Delimited totals data
; Returns: Line of text for output to report
N Y
S Y=LABLE
S $E(Y,34)=$J($P(DATA,U,1),7,2) ; Copay AMOUNT
S $E(Y,43)=$J($P(DATA,U,2),7,2) ; Auto-Decrease Amount
S $E(Y,54)=$J($P(DATA,U,3),7,2) ; Manual Decrease Amount
S $E(Y,66)=$J($P(DATA,U,4),7,2) ; Total Decrease Amount
S $E(Y,76)=$J($P(DATA,U,5),5) ; Auto-release count
Q Y
;
PERCENTS(LABLE,DATA) ; Build Daily or Grand Total percentage line
; Input: LABLE - Text to prepend to totals line
; DATA - Delimited totals data
; Returns: Line of text for output to report
N RCCOPAY,LN,Y
S LN=LABLE
S RCCOPAY=$P(DATA,U,1)
S Y=$S(RCCOPAY>0:$P(DATA,U,2)/RCCOPAY*100,1:"")
S $E(LN,44)=$$FMT(Y,2)
S Y=$S(RCCOPAY>0:$P(DATA,U,3)/RCCOPAY*100,1:"")_"%"
S $E(LN,55)=$$FMT(Y,2)
S Y=$S(RCCOPAY>0:$P(DATA,U,4)/RCCOPAY*100,1:"")_"%"
S $E(LN,67)=$$FMT(Y,2)
S Y=$S($P(DATA,U,6):$P(DATA,U,5)/$P(DATA,U,6)*100,1:"")
S $E(LN,77)=$$FMT(Y,0,4)
Q LN
;
FMT(VALUE,PLACES,JUST) ; Format a % value for output
; Input: VALUE - Value to be formated
; PLACES - Number of decimal places for number
; JUST - Length in which to $JUSTIFY (optional defaults to 7)
; Returns: Formated value
N RETURN
S RETURN=""
I $G(JUST)="" S JUST=7
I VALUE'="" D ;
. I VALUE=0!(VALUE=100) S RETURN=$FN(VALUE,"",0)
. E S RETURN=$FN(VALUE,"",PLACES)
. S RETURN=RETURN_"%"
Q $J(RETURN,JUST)
;
HDR(EXCEL,HDRINFO,PAGE,NOLINE) ; Print the report header
; Input: EXCEL - 1 if output to Excel, 0 otherwise
; HDRINFO() - Array of Header information
; PAGE - Current Page Number
; NOLINE - 1 to not display Claim line header
; Optional, defaults to 0
; Output: PAGE - Updated Page Number (if EXCEL=0)
N DIV,MSG,SUB,XX,Y,Z0,Z1
S:'$D(NOLINE) NOLINE=0
I EXCEL D Q
. W !,"STATION^STATION NUMBER^COPAY BILL #^3RD PARTY BILL #^DATE^COPAY AMOUNT^AUTO-DECREASE AMOUNT^"
. W "MANUAL DECREASE AMOUNT^TOTAL DECREASE AMOUNT^AUTO RELEASE HOLD"
;
S PAGE=PAGE+1
W @IOF
S MSG(1)="First Party COPAY Manual vs Auto-Decrease Report"
S MSG(1)=$J("",(80-$L(MSG(1))\2))_MSG(1)
S MSG(1)=MSG(1)_" Page: "_PAGE
S MSG(2)=" Run Date: "_HDRINFO("RUNDATE")
S Z0="Divisions: "_HDRINFO("DIVISIONS")
S MSG(3)=$S($L(Z0)<75:$J("",75-$L(Z0)\2),1:"")_Z0
S XX=" (Date of Latest Decrease)"
S MSG(4)=" Date Range: "_HDRINFO("START")_" - "_HDRINFO("END")_XX
S MSG(5)=" "_HDRINFO("SORT")_" "_HDRINFO("DISP")
I $G(DISP)="D" S MSG(6)=" 3rd Party Copay Auto-Decr Man Decr Total Decr Rel"
E S MSG(6)=" Copay Auto-Decr Man Decr Total Decr Rel"
I 'NOLINE D
. I $G(DISP)="D" S MSG(7)="COPAY Bill # Bill# Date Amt Amt Amt Amt Hold"
. E S MSG(7)=" Amt Amt Amt Amt Hold"
. S MSG(8)=$TR($J("",80)," ","-")
D EN^DDIOL(.MSG)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEFA3 19616 printed Oct 16, 2024@17:45:28 Page 2
RCDPEFA3 ;AITC/CJE - 1ST PARTY AUTO DECREASE VS MANUAL DECREASE REPORT;Jun 06, 2014@19:11:19 ; 7/3/19 8:41am
+1 ;;4.5;Accounts Receivable;**345,349**;Mar 20, 1995;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Entry point for Manual vs Auto-Decrease Adjustment Report [RCDPE FIRST PARTY MANUAL VS AUTO]
+1 NEW INPUT,RCVAUTD
+2 ; Division filter
SET INPUT=$$STADIV^RCDPEFA2(.RCVAUTD)
+3 if 'INPUT
QUIT
+4 ; Display detailed or summary report
SET $PIECE(INPUT,U,2)=$$DETSUM^RCDPEFA2
+5 ; '^' or timeout
if $PIECE(INPUT,U,2)=0
QUIT
+6 SET $PIECE(INPUT,U,3)="F"
+7 ; Select Sort Criteria
IF $PIECE(INPUT,U,2)="D"
Begin DoDot:1
+8 SET $PIECE(INPUT,U,3)=$$SORTORD^RCDPEFA2("C")
End DoDot:1
+9 ; '^' or timeout
if $PIECE(INPUT,U,3)=0
QUIT
+10 WRITE !!,"Include first party bills where the latest decrease falls within the following"
+11 WRITE !,"date range",!
+12 ; Select Date Range for Report
SET $PIECE(INPUT,U,4)=$$DTRNG^RCDPEFA2
+13 ; '^' or timeout
if '$PIECE(INPUT,U,4)
QUIT
+14 SET $PIECE(INPUT,U,4)=$PIECE($PIECE(INPUT,U,4),"|",2,3)
+15 ; Ask to Display in Listman Template
SET $PIECE(INPUT,U,5)=$$ASKLM^RCDPEARL
+16 ; '^' or timeout
if $PIECE(INPUT,U,5)<0
QUIT
+17 ; Compile data and call listman to display
IF $PIECE(INPUT,U,5)=1
Begin DoDot:1
+18 DO LMOUT^RCDPEFA4(INPUT,.RCVAUTD,.IO)
End DoDot:1
QUIT
+19 ;
IF $PIECE(INPUT,U,2)="D"
Begin DoDot:1
+20 ; Select Display Type
SET $PIECE(INPUT,U,6)=$$DISPTY^RCDPEFA2
End DoDot:1
+21 ; '^' or timeout
if $PIECE(INPUT,U,6)=-1
QUIT
+22 ; Display capture information for Excel
if $PIECE(INPUT,U,6)=1
DO INFO^RCDPEM6
+23 ; Ask output device
if '$$DEVICE^RCDPEFA2(.IO)
QUIT
+24 ;
+25 ; Compile and Display Report data (queued) - not allowed for EXCEL
+26 IF $PIECE(INPUT,U,5)'=1
IF $DATA(IO("Q"))
Begin DoDot:1
+27 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+28 SET ZTRTN="REPORT^RCDPEFA3(INPUT,.RCVAUTD,.IO)"
+29 SET ZTDESC="EDI LOCKBOX FIRST PARTY AUTO-DECREASE REPORT"
+30 SET ZTSAVE("RC*")=""
SET ZTSAVE("INPUT")=""
SET ZTSAVE("IO*")=""
+31 DO ^%ZTLOAD
+32 WRITE !!,$SELECT($GET(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
+33 KILL IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+34 ; Create report
DO REPORT(INPUT,.RCVAUTD,.IO)
+35 ;
+36 ; Clear ^TMP global
KILL ^TMP("RCDPEFADP3",$JOB),^TMP("RCDPE_ADP3",$JOB)
+37 QUIT
+38 ;
REPORT(INPUTS,RCVAUTD,IO) ; Compile and print report
+1 ; Input: INPUTS - A1^A2^A3^...^An Where:
+2 ; A1 - 1 - All divisions selected, 2 - Selected divisions
+3 ; A2 - D - Detail Report, S - Summary Report
+4 ; A3 - F - sort First to Last, L - sort Last to First
+5 ; A4 - B1|B2
+6 ; B1 - Decrease Transaction Date Entered Start
+7 ; B2 - Decrease Transaction Date Entered End
+8 ; A5 - 1 - Output to List Manager, else 0
+9 ; A6 - 1 - Output to Excel, else 0
+10 ; RCVAUTD - Array of selected Divisions, Only passed if A1=2
+11 ; IO - Output Device
+12 NEW RCTOTAL,XX,ZTREQ
+13 ; PRCA*4.5*349 Added check to skip if in listman mode
if $PIECE(INPUTS,"^",5)'=1
USE IO
+14 KILL ^TMP("RCDPEFADP3",$JOB),^TMP("RCDPE_ADP3",$JOB)
+15 ; Scan AR TRANSACTION file for entries in date range
DO COMPILE(INPUTS,.RCVAUTD)
+16 ; Display Report
DO DISP(INPUTS)
+17 ; Close device
DO ^%ZISC
+18 QUIT
+19 ;
COMPILE(INPUTS,RCVAUTD) ; Compile Report Data
+1 NEW BEG,DAIEN,END,EXCEL,RC430IEN,RCAMT,RCBILL,RCBILL3,RCCOPAY,RCDT
+2 NEW RCSITE,RCSORT,RCTR,RCTRAND,RCUSER,STNAM,STNUM,TRANDA,X,XX
+3 ;
+4 ; Auto-Post Date range
SET XX=$PIECE(INPUTS,U,4)
+5 SET BEG=$$FMADD^XLFDT($PIECE(XX,"|",1),-1)
+6 ; Auto-Post End Date
SET END=$PIECE(XX,"|",2)
+7 ; Record counter
SET RCTR=0
+8 ; 1 output to Excel, 0 otherwise
SET EXCEL=$PIECE(INPUTS,U,6)
+9 ; Sort Type
SET RCSORT=$PIECE(INPUTS,U,2)
+10 ;
+11 ; Scan index for auto-posted claim lines within the ERA
+12 ; and Save claim line detail to ^TMP global
+13 ; Get IEN of 'DECREASE ADJUSTMENT' fron #430.3
+14 SET DAIEN=$ORDER(^PRCA(430.3,"B","DECREASE ADJUSTMENT",""))
+15 ;
+16 ; Scan AR Transaction date index for days
+17 SET RCTRAND=BEG
+18 FOR
SET RCTRAND=$ORDER(^PRCA(433,"AT",DAIEN,RCTRAND))
if 'RCTRAND!(RCTRAND>END)
QUIT
Begin DoDot:1
+19 ;
+20 ; Scan AR transactions
+21 SET TRANDA=""
+22 FOR
SET TRANDA=$ORDER(^PRCA(433,"AT",DAIEN,RCTRAND,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:2
+23 ; Get AR ACCOUNT
SET RC430IEN=$$GET1^DIQ(433,TRANDA_",",.03,"I")
+24 if 'RC430IEN
QUIT
+25 ; Get SITE ien
SET RCSITE=$$GET1^DIQ(430,RC430IEN_",",12,"I")
+26 if 'RCSITE
QUIT
+27 ;
+28 ; Ignore transaction if not a selected Division
+29 IF $PIECE(INPUTS,U,1)=2
IF '$DATA(RCVAUTD(RCSITE))
QUIT
+30 ; Copay Claim #
SET RCBILL=$$GET1^DIQ(433,TRANDA_",",.03,"I")
+31 ; Make sure this is first party - DEBTOR is a patient
+32 if $$GET1^DIQ(340,$$GET1^DIQ(430,RC430IEN_",",9,"I")_",",.01,"I")'["DPT"
QUIT
+33 ; Bill already stored
IF $DATA(^TMP("RCDPEFADP3",$JOB,"BILL",RCBILL))
QUIT
+34 ; Check that the last decrease falls in the date range, if so store the results
+35 DO CHKBILL(RCBILL,BEG,END,.RCTR)
End DoDot:2
End DoDot:1
+36 ;
+37 QUIT
+38 ;
CHKBILL(RCBILL,BEG,END,RCTR) ; Check date of last decrease transaction, store if inside date range.
+1 ; Input: RCBILL - Internal entry number to file 430.
+2 ; BEG - Beginning date range -1 day, FileMan format
+3 ; END - Ending date range, FileMan format
+4 ; RCTR - Record counter passed by reference
+5 ;
+6 NEW RCAMT,RCBILL3,RCCOPAY,RCDTI,RCPROC,RCTLIS,RCTOT,RCUSER,RELEASE,STNUM,STNAME,TRANDA,X,Y
+7 SET (TRANDA,RCDTI)=""
+8 FOR X="A","M","T"
SET RCTOT(X)=0
+9 ;
FOR
SET TRANDA=$ORDER(^PRCA(433,"C",RCBILL,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:1
+10 ;
IF $$GET1^DIQ(433,TRANDA_",",12,"E")'="DECREASE ADJUSTMENT"
QUIT
+11 SET X=$$GET1^DIQ(433,TRANDA_",",11,"I")
+12 IF X>RCDTI
SET RCDTI=X
+13 SET RCTLIS(TRANDA)=""
End DoDot:1
+14 ;
+15 ; Is last decrease inside selected date range? If not quit.
+16 IF RCDTI'>BEG!(RCDTI>END)
QUIT
+17 ;
+18 SET RCBILL3=" "
+19 ; Station name/number
DO DIV^RCDPEFA1(RCBILL,.STNUM,.STNAM)
+20 SET X=$$GET1^DIQ(430,RCBILL_",",.01,"E")
+21 ; IEN in file #350
SET XX=$ORDER(^IB("ABIL",X,0))
+22 ; Ignore decrease for charges that were cancelled etc.
IF $$GET1^DIQ(350,XX_",",.05,"E")'="BILLED"
QUIT
+23 ; Copay Amount
SET RCCOPAY=$$GET1^DIQ(350,XX_",",.07,"E")
+24 ; Processed by
SET RCPROC=$$GET1^DIQ(430,RCBILL_",",97,"E")
+25 ; Auto-release from hold if bill processed by postmaster
SET RELEASE=$SELECT(RCPROC="POSTMASTER":1,1:0)
+26 ;
+27 ; Get all decrease transactions for this bill;
+28 SET TRANDA=""
+29 ;
FOR
SET TRANDA=$ORDER(RCTLIS(TRANDA))
if 'TRANDA
QUIT
Begin DoDot:1
+30 ; Get user
SET RCUSER=$$GET1^DIQ(433,TRANDA_",",42,"E")
+31 SET Y=$$GET1^DIQ(433,TRANDA_",",94,"E")
+32 IF RCBILL3=" "
IF Y'=""
SET RCBILL3=Y
+33 SET X=$SELECT(RCUSER="POSTMASTER"&(Y'=" "):"A",1:"M")
+34 ; Transaction amount
SET RCAMT=$$GET1^DIQ(433,TRANDA_",",15,"E")
+35 ; Running total of manual or auto decrease
SET RCTOT(X)=$GET(RCTOT(X))+RCAMT
+36 ; Running total decrease for this bill
SET RCTOT("T")=$GET(RCTOT("T"))+RCAMT
+37 ;
End DoDot:1
+38 ;
+39 DO SAVE(RCBILL,RCBILL3,RCDTI,RCCOPAY,RELEASE,.RCTOT,.RCTR)
+40 SET ^TMP("RCDPEFADP3",$JOB,"BILL",RCBILL)=""
+41 QUIT
+42 ;
SAVE(RCBILL,RCBILL3,RCDTI,RCCOPAY,RELEASE,RCTOT,RCTR) ; Put data into ^TMP
+1 ; Input: RCBILL - Copay Claim #
+2 ; RCBILL3 - 3rd Party Claim #
+3 ; RCDTI - Auto-decrease date (internal)
+4 ; RCCOPAY - Copay Amount
+5 ; RELEASE - 1 charge was auto-released from hold, 0 otherwise
+6 ; RCTOT - Decrease totals in an array passed by reference
+7 ; RCTOT("A") - Auto-decrease total
+8 ; RCTOT("M") - Manual decrease total
+9 ; RCTOT("T") - Total decrease
+10 ; Output: DTOTAL() - RCTR - Record Counter passed by reference
+11 ; ^TMP("RCDPEFADP3",$J,A1,A2,A3) = B1^B2^B3^...^Bn Where:
+12 ; A1 - "EXCEL" if report to excel, fileman date if not
+13 ; A2 - Excel Line Counter if to excel, Claim # if sort by claim,
+14 ; A3 - Record Counter
+15 ; B1 - External Station Name
+16 ; B2 - External Station Number
+17 ; B3 - Copay Bill Number
+18 ; B4 - 3rd Party Bill Number
+19 ; B5 - Auto-Decrease Date
+20 ; B6 - Copay Amount
+21 ; B7 - Auto-Decrease Amount
+22 ; B8 - Manual Decrease Amount
+23 ; B9 - Total decrease Amount
+24 ; B10 - Auto-release from hold flag
+25 ;
+26 NEW A1,A2,XX,CNT,RCDT,RCTOTAL
+27 SET RCTR=RCTR+1
+28 ;
+29 ; Transaction date External
SET RCDT=$$FMTE^XLFDT(RCDTI,"2SZ")
+30 ; If EXCEL sorting is done in EXCEL
+31 IF EXCEL=1
Begin DoDot:1
+32 SET A1="EXCEL"
SET A2=$GET(^TMP("RCDPEFADP3",$JOB,A1))+1
+33 SET ^TMP("RCDPEFADP3",$JOB,A1)=A2
End DoDot:1
+34 ;
+35 ; Otherwise sort by DATE and Bill Number
+36 IF 'EXCEL
Begin DoDot:1
+37 SET A1=RCDTI
+38 SET A2=RCBILL
End DoDot:1
+39 ;
+40 ; Update ^TMP gif claim level adjustments found for this claim
+41 SET XX=STNAM_U_STNUM_U_$$GET1^DIQ(430,RCBILL_",",.01,"E")
+42 SET XX=XX_U_RCBILL3_U_RCDT_U_RCCOPAY_U_RCTOT("A")_U_RCTOT("M")_U_RCTOT("T")_U_RELEASE
+43 ; Claim Information
SET ^TMP("RCDPEFADP3",$JOB,"DATA",A1,A2,RCTR)=XX
+44 ;
+45 ; Update totals for date
+46 SET RCTOTAL=$GET(^TMP("RCDPEFADP3",$JOB,"TOTALS",RCDTI))
+47 SET ^TMP("RCDPEFADP3",$JOB,"TOTALS",RCDTI)=$$TOTAL(RCTOTAL,RCCOPAY,RELEASE,.RCTOT)
+48 ;
+49 ; Update totals for date range
+50 SET RCTOTAL=$GET(^TMP("RCDPEFADP3",$JOB,"TOTALS"))
+51 SET ^TMP("RCDPEFADP3",$JOB,"TOTALS")=$$TOTAL(RCTOTAL,RCCOPAY,RELEASE,.RCTOT)
+52 ;
+53 QUIT
+54 ;
TOTAL(RCTOTAL,RCCOPAY,RELEASE,RCTOT) ; Increment daily or overall totals
+1 ; Input : RCTOTAL - old total
+2 ; : RCCOPAY - COPAY amount
+3 ; : RELEASE - Flag 0, 1 if bill was created by auto-releasing a charge from hold
+4 ; : RCTOTAL - Array passed by reference of manual, auto and total decreases for this bill
+5 SET $PIECE(RCTOTAL,U,1)=$PIECE(RCTOTAL,U,1)+RCCOPAY
+6 SET $PIECE(RCTOTAL,U,2)=$PIECE(RCTOTAL,U,2)+RCTOT("A")
+7 SET $PIECE(RCTOTAL,U,3)=$PIECE(RCTOTAL,U,3)+RCTOT("M")
+8 SET $PIECE(RCTOTAL,U,4)=$PIECE(RCTOTAL,U,4)+RCTOT("T")
+9 ; # of bills created by auto-release from hold
SET $PIECE(RCTOTAL,U,5)=$PIECE(RCTOTAL,U,5)+$SELECT(RELEASE:1,1:0)
+10 ; Total number of bills
SET $PIECE(RCTOTAL,U,6)=$PIECE(RCTOTAL,U,6)+1
+11 QUIT RCTOTAL
+12 ;
DISP(INPUTS) ; Format the display for screen/printer or MS Excel
+1 ; Input: INPUTS - See REPORT for details
+2 ; ^TMP("RCDPEFADP",$J) - See SAVE for description
+3 NEW A1,A2,A3,DATA,EXCEL,GTOTAL,HDRINFO,LMAN,LCNT,MODE,PAGE,RCRDNUM,STOP,X,Y,DISP
+4 ; PRCA*4.5*349 Added check to skip if in listman mode
if $PIECE(INPUTS,"^",5)'=1
USE IO
+5 SET EXCEL=$PIECE(INPUTS,U,6)
SET LMAN=$PIECE(INPUTS,U,5)
SET DISP=$PIECE(INPUTS,U,2)
+6 ;
+7 ; Header information
+8 ; Auto-Post Date range
SET XX=$PIECE(INPUTS,U,4)
+9 SET HDRINFO("START")=$$FMTE^XLFDT($PIECE(XX,"|",1),"2SZ")
+10 SET HDRINFO("END")=$$FMTE^XLFDT($PIECE(XX,"|",2),"2SZ")
+11 SET HDRINFO("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ")
+12 SET HDRINFO("SORT")="Sorted By: Claim"
+13 SET XX=$SELECT($PIECE(INPUTS,U,3)="L":"Last to First",1:"First to Last")
+14 SET HDRINFO("SORT")=HDRINFO("SORT")_" - "_XX
+15 SET HDRINFO("DISP")="Display: "_$SELECT(DISP="S":"Summary",1:"Detail")
+16 ;
+17 ; Format Division filter
+18 ; XX=1 - All Divisions, 2- selected
SET XX=$PIECE(INPUTS,U,1)
+19 SET HDRINFO("DIVISIONS")=$SELECT(XX=2:$$LINE(.RCVAUTD),1:"ALL")
+20 ;
+21 SET A1=""
SET PAGE=0
SET STOP=0
SET LCNT=1
+22 IF 'LMAN
IF DISP="S"
DO HDR(EXCEL,.HDRINFO,.PAGE)
+23 ; Mode for $ORDER
SET MODE=$SELECT($PIECE(INPUTS,U,3)="L":-1,1:1)
+24 FOR
Begin DoDot:1
+25 SET A1=$ORDER(^TMP("RCDPEFADP3",$JOB,"DATA",A1))
+26 if A1=""
QUIT
+27 ; Display Header
IF 'LMAN
IF DISP="D"
Begin DoDot:2
+28 ; Output to screen, quit if user wants to
IF PAGE
DO ASK^RCDPEFA1(.STOP,0)
if STOP
QUIT
+29 DO HDR(EXCEL,.HDRINFO,.PAGE)
End DoDot:2
if STOP
QUIT
+30 SET A2=""
+31 FOR
Begin DoDot:2
+32 SET A2=$ORDER(^TMP("RCDPEFADP3",$JOB,"DATA",A1,A2),MODE)
+33 IF 'EXCEL
IF A2=""
DO TOTALD(LMAN,.HDRINFO,.PAGE,.STOP,A1,.LCNT)
+34 if A2=""
QUIT
+35 ; Skip printing details if summary report
if DISP="S"
QUIT
+36 SET A3=0
+37 FOR
Begin DoDot:3
+38 SET A3=$ORDER(^TMP("RCDPEFADP3",$JOB,"DATA",A1,A2,A3))
+39 if 'A3
QUIT
+40 ; Auto-Decreased Claim
SET DATA=^TMP("RCDPEFADP3",$JOB,"DATA",A1,A2,A3)
+41 ; Output to Excel
IF EXCEL
WRITE !,DATA
QUIT
+42 ; End of page
IF 'LMAN
IF $Y>(IOSL-4)
Begin DoDot:4
+43 DO ASK^RCDPEFA1(.STOP,0)
+44 if STOP
QUIT
+45 DO HDR(EXCEL,.HDRINFO,.PAGE)
End DoDot:4
if STOP
QUIT
+46 ; 1st Party Bill
SET Y=$PIECE(DATA,U,3)
+47 ; 3rd Party Bill
SET $EXTRACT(Y,13)=$PIECE(DATA,U,4)
+48 ; Decrease Date
SET $EXTRACT(Y,26)=$PIECE(DATA,U,5)
+49 ; Copay AMOUNT
SET $EXTRACT(Y,34)=$JUSTIFY($PIECE(DATA,U,6),7,2)
+50 ; Auto-Decrease Amount
SET $EXTRACT(Y,43)=$JUSTIFY($PIECE(DATA,U,7),7,2)
+51 ; Manual Decrease Amount
SET $EXTRACT(Y,54)=$JUSTIFY($PIECE(DATA,U,8),7,2)
+52 ; Total Decrease Amount
SET $EXTRACT(Y,66)=$JUSTIFY($PIECE(DATA,U,9),7,2)
+53 ; Auto-release flag
SET $EXTRACT(Y,80)=$SELECT($PIECE(DATA,U,10):"*",1:" ")
+54 IF LMAN
Begin DoDot:4
+55 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=Y
SET LCNT=LCNT+1
End DoDot:4
+56 IF '$TEST
Begin DoDot:4
+57 WRITE !,Y
End DoDot:4
End DoDot:3
if 'A3!STOP
QUIT
End DoDot:2
if (A2="")!STOP
QUIT
End DoDot:1
if (A1="")!STOP
QUIT
+58 ;
+59 ; Grand totals
+60 SET GTOTAL=$PIECE($GET(^TMP("RCDPEFADP3",$JOB,"TOTALS")),"^",6)
+61 IF GTOTAL
Begin DoDot:1
+62 ; Print grand total if not Excel
IF 'STOP
IF 'EXCEL
Begin DoDot:2
+63 DO TOTALG(LMAN,.HDRINFO,.PAGE,.STOP,.LCNT)
End DoDot:2
+64 ; Report finished
IF 'EXCEL
IF 'LMAN
Begin DoDot:2
+65 WRITE !,$$ENDORPRT^RCDPEARL,!
+66 if 'LMAN
DO ASK^RCDPEFA1(.STOP,1)
End DoDot:2
End DoDot:1
+67 ;
+68 ; Null Report
+69 IF 'GTOTAL
IF 'LMAN
Begin DoDot:1
+70 IF PAGE=0
DO HDR(EXCEL,.HDRINFO,.PAGE)
+71 WRITE !!,?26,"*** No Records to Print ***",!
+72 WRITE !,$$ENDORPRT^RCDPEARL
+73 if '$DATA(ZTQUEUED)
SET X=$$ASKSTOP^RCDPELAR
End DoDot:1
+74 ;
+75 ; List manager
+76 IF LMAN
Begin DoDot:1
+77 if LCNT=1
SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=$JUSTIFY("",26)_"*** No Records to Print ***"
SET LCNT=LCNT+1
+78 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=" "
SET LCNT=LCNT+1
+79 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=$$ENDORPRT^RCDPEARL
End DoDot:1
+80 ; Close device
+81 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+82 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+83 QUIT
+84 ;
LINE(DIV) ; List selected stations
+1 ; Input: DIV() - Array of selected divisions
+2 ; Returns: Comma delimited list of selected divisions
+3 NEW LINE,P,SUB
+4 SET LINE=""
SET SUB=""
SET P=0
+5 FOR
SET SUB=$ORDER(DIV(SUB))
if 'SUB
QUIT
SET P=P+1
SET $PIECE(LINE,", ",P)=$GET(DIV(SUB))
+6 QUIT LINE
+7 ;
TOTALG(LMAN,HDRINFO,PAGE,STOP,LCNT) ;
+1 ; Input: LMAN - 1 if output to Listman, 0 otherwise
+2 ; HDRINFO - Array of header info
+3 ; PAGE - Current Page Number
+4 ; LCNT - Current line count (only passedif LMAN=1)
+5 ; Output: PAGE - Updated Page Number (if new header is displayed)
+6 ; LCNT - Updated line count (only passedif LMAN=1)
+7 NEW DATA,LN1,LN2
+8 SET DATA=^TMP("RCDPEFADP3",$JOB,"TOTALS")
+9 SET LN1=$$TOTALS("**** Totals for Date Range:",DATA)
+10 SET LN2=$$PERCENTS(" Percent for Date Range:",DATA)
+11 ;
+12 IF LMAN
Begin DoDot:1
+13 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=""
SET LCNT=LCNT+1
+14 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=LN1
SET LCNT=LCNT+1
+15 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=LN2
SET LCNT=LCNT+1
End DoDot:1
QUIT
+16 ;
+17 IF $Y>(IOSL-6)
Begin DoDot:1
+18 DO ASK^RCDPEADP(.STOP,0)
+19 if STOP
QUIT
+20 DO HDR(EXCEL,.HDRINFO,.PAGE)
End DoDot:1
+21 if STOP
QUIT
+22 WRITE !!,LN1
+23 WRITE !,LN2,!
+24 QUIT
+25 ;
TOTALD(LMAN,HDRINFO,PAGE,STOP,DAY,LCNT) ; Totals for a single day
+1 ; Input: LMAN - 1 if output to List Template, 0 otherwise
+2 ; HDRINFO - Array of header information
+3 ; PAGE - Page Number
+4 ; DAY - FileMan date to display totals for
+5 ; LCNT - Current line count (only passedif LMAN=1)
+6 ; Output: PAGE - Updated Page Number (if a new header is displayed)
+7 ; STOP - 1 if user indiacted to stop
+8 ; LCNT - Updated line count (only passedif LMAN=1)
+9 NEW DAMT,DCNT,LN1,LN2,RCCOPAY,RCDT,Y
+10 SET RCDT=$$FMTE^XLFDT(DAY,"2Z")
+11 SET DATA=^TMP("RCDPEFADP3",$JOB,"TOTALS",DAY)
+12 SET LN1=$$TOTALS(" **Totals for Date "_RCDT_":",DATA)
+13 SET LN2=$$PERCENTS(" Percent for Date "_RCDT_":",DATA)
+14 ;
+15 IF LMAN
Begin DoDot:1
+16 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=""
SET LCNT=LCNT+1
+17 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=LN1
SET LCNT=LCNT+1
+18 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=LN2
SET LCNT=LCNT+1
+19 SET ^TMP("RCDPE_ADP3",$JOB,LCNT)=""
SET LCNT=LCNT+1
End DoDot:1
QUIT
+20 ;
+21 IF $Y>(IOSL-4)
Begin DoDot:1
+22 DO ASK^RCDPEADP(.STOP,0)
+23 if STOP
QUIT
+24 DO HDR(EXCEL,.HDRINFO,.PAGE)
End DoDot:1
+25 if STOP
QUIT
+26 WRITE !!,LN1
+27 WRITE !,LN2
+28 QUIT
+29 ;
TOTALS(LABLE,DATA) ; Build Daily or Grand Total string
+1 ; Input: LABLE - Text to prepend to totals line
+2 ; DATA - Delimited totals data
+3 ; Returns: Line of text for output to report
+4 NEW Y
+5 SET Y=LABLE
+6 ; Copay AMOUNT
SET $EXTRACT(Y,34)=$JUSTIFY($PIECE(DATA,U,1),7,2)
+7 ; Auto-Decrease Amount
SET $EXTRACT(Y,43)=$JUSTIFY($PIECE(DATA,U,2),7,2)
+8 ; Manual Decrease Amount
SET $EXTRACT(Y,54)=$JUSTIFY($PIECE(DATA,U,3),7,2)
+9 ; Total Decrease Amount
SET $EXTRACT(Y,66)=$JUSTIFY($PIECE(DATA,U,4),7,2)
+10 ; Auto-release count
SET $EXTRACT(Y,76)=$JUSTIFY($PIECE(DATA,U,5),5)
+11 QUIT Y
+12 ;
PERCENTS(LABLE,DATA) ; Build Daily or Grand Total percentage line
+1 ; Input: LABLE - Text to prepend to totals line
+2 ; DATA - Delimited totals data
+3 ; Returns: Line of text for output to report
+4 NEW RCCOPAY,LN,Y
+5 SET LN=LABLE
+6 SET RCCOPAY=$PIECE(DATA,U,1)
+7 SET Y=$SELECT(RCCOPAY>0:$PIECE(DATA,U,2)/RCCOPAY*100,1:"")
+8 SET $EXTRACT(LN,44)=$$FMT(Y,2)
+9 SET Y=$SELECT(RCCOPAY>0:$PIECE(DATA,U,3)/RCCOPAY*100,1:"")_"%"
+10 SET $EXTRACT(LN,55)=$$FMT(Y,2)
+11 SET Y=$SELECT(RCCOPAY>0:$PIECE(DATA,U,4)/RCCOPAY*100,1:"")_"%"
+12 SET $EXTRACT(LN,67)=$$FMT(Y,2)
+13 SET Y=$SELECT($PIECE(DATA,U,6):$PIECE(DATA,U,5)/$PIECE(DATA,U,6)*100,1:"")
+14 SET $EXTRACT(LN,77)=$$FMT(Y,0,4)
+15 QUIT LN
+16 ;
FMT(VALUE,PLACES,JUST) ; Format a % value for output
+1 ; Input: VALUE - Value to be formated
+2 ; PLACES - Number of decimal places for number
+3 ; JUST - Length in which to $JUSTIFY (optional defaults to 7)
+4 ; Returns: Formated value
+5 NEW RETURN
+6 SET RETURN=""
+7 IF $GET(JUST)=""
SET JUST=7
+8 ;
IF VALUE'=""
Begin DoDot:1
+9 IF VALUE=0!(VALUE=100)
SET RETURN=$FNUMBER(VALUE,"",0)
+10 IF '$TEST
SET RETURN=$FNUMBER(VALUE,"",PLACES)
+11 SET RETURN=RETURN_"%"
End DoDot:1
+12 QUIT $JUSTIFY(RETURN,JUST)
+13 ;
HDR(EXCEL,HDRINFO,PAGE,NOLINE) ; Print the report header
+1 ; Input: EXCEL - 1 if output to Excel, 0 otherwise
+2 ; HDRINFO() - Array of Header information
+3 ; PAGE - Current Page Number
+4 ; NOLINE - 1 to not display Claim line header
+5 ; Optional, defaults to 0
+6 ; Output: PAGE - Updated Page Number (if EXCEL=0)
+7 NEW DIV,MSG,SUB,XX,Y,Z0,Z1
+8 if '$DATA(NOLINE)
SET NOLINE=0
+9 IF EXCEL
Begin DoDot:1
+10 WRITE !,"STATION^STATION NUMBER^COPAY BILL #^3RD PARTY BILL #^DATE^COPAY AMOUNT^AUTO-DECREASE AMOUNT^"
+11 WRITE "MANUAL DECREASE AMOUNT^TOTAL DECREASE AMOUNT^AUTO RELEASE HOLD"
End DoDot:1
QUIT
+12 ;
+13 SET PAGE=PAGE+1
+14 WRITE @IOF
+15 SET MSG(1)="First Party COPAY Manual vs Auto-Decrease Report"
+16 SET MSG(1)=$JUSTIFY("",(80-$LENGTH(MSG(1))\2))_MSG(1)
+17 SET MSG(1)=MSG(1)_" Page: "_PAGE
+18 SET MSG(2)=" Run Date: "_HDRINFO("RUNDATE")
+19 SET Z0="Divisions: "_HDRINFO("DIVISIONS")
+20 SET MSG(3)=$SELECT($LENGTH(Z0)<75:$JUSTIFY("",75-$LENGTH(Z0)\2),1:"")_Z0
+21 SET XX=" (Date of Latest Decrease)"
+22 SET MSG(4)=" Date Range: "_HDRINFO("START")_" - "_HDRINFO("END")_XX
+23 SET MSG(5)=" "_HDRINFO("SORT")_" "_HDRINFO("DISP")
+24 IF $GET(DISP)="D"
SET MSG(6)=" 3rd Party Copay Auto-Decr Man Decr Total Decr Rel"
+25 IF '$TEST
SET MSG(6)=" Copay Auto-Decr Man Decr Total Decr Rel"
+26 IF 'NOLINE
Begin DoDot:1
+27 IF $GET(DISP)="D"
SET MSG(7)="COPAY Bill # Bill# Date Amt Amt Amt Amt Hold"
+28 IF '$TEST
SET MSG(7)=" Amt Amt Amt Amt Hold"
+29 SET MSG(8)=$TRANSLATE($JUSTIFY("",80)," ","-")
End DoDot:1
+30 DO EN^DDIOL(.MSG)
+31 QUIT
+32 ;
