RCDPEFA1 ;AITC/FA - FIRST PARTY AUTO-DECREASE REPORT ; 6/12/19 7:36am
;;4.5;Accounts Receivable;**345,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
; Read ^DG(40.8) - IA 417
; DIVISION^VAUTOMA - IA 664
;
EN ; entry point for Auto-Decrease Adjustment report [RCDPE FIRST PARTY AUTO-DECREASE]
N INPUT,RCVAUTD,DISP
S INPUT=$$STADIV^RCDPEFA2(.RCVAUTD) ; Division filter
Q:'INPUT ; '^' or timeout
S DISP=$$DETSUM^RCDPEFA2 ; PRCA*4.5*349 - Display detailed or summary report
Q:DISP=0
S $P(INPUT,U,8)=DISP
S $P(INPUT,U,7)="A" ; '^' or timeout
I DISP="D" D ;
. S $P(INPUT,U,7)=$$ASKPAT^RCDPEFA2 ; PRCA*4.5*349 - Filter by Patient or 'ALL'
Q:$P(INPUT,U,7)=0 ; '^' or timeout
S $P(INPUT,U,2)="C"
I DISP="D" S $P(INPUT,U,2)=$$ASKSORT^RCDPEFA2 ; Select Sort Criteria
Q:$P(INPUT,U,2)=0 ; '^' or timeout
S $P(INPUT,U,3)="F"
I DISP="D" D ;
. S $P(INPUT,U,3)=$$SORTORD^RCDPEFA2($P(INPUT,U,2)) ; Select Sort Order
Q:$P(INPUT,U,3)=0 ; '^' or timeout
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,6)=$$ASKLM^RCDPEARL ; Ask to Display in Listman Template
Q:$P(INPUT,U,6)<0 ; '^' or timeout
I $P(INPUT,U,6)=1 D Q ; Compile data and call listman to display
. D LMOUT(INPUT,.RCVAUTD,.IO)
I DISP="D" S $P(INPUT,U,5)=$$DISPTY^RCDPEFA2 ; Select Display Type
Q:$P(INPUT,U,5)=-1 ; '^' or timeout
I $P(INPUT,U,5)=1 D 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^RCDPEFAD(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
Q
;
REPORT(INPUTS,RCVAUTD,IO) ;EP Compile and print report
; Input: INPUTS - A1^A2^A3^...^An Where:
; A1 - 1 - All divisions selected, 2 - Selected divisions
; A2 - C - Sort by Claim, N - Sort by Patient Name
; A3 - F - sort First to Last, L - sort Last to First
; A4 - B1|B2
; B1 - Auto-Post Start Date
; B2 - Auto-Post End Date
; A5 - 1 - Output to Excel, else 0
; A6 - 1 - Output to List Manager, else 0
; A7 - C1|C2
; C1 - P - Filter list by Patient
; A - Show all 1st Party Auto-Decreases"
; C2 - IEN into file #2 (if C1=P, null otherwise)
; RCVAUTD - Array of selected Divisions, Only passed if A1=2
; IO - Output Device
N DTOTAL,GTOTAL,XX,ZTREQ
U IO
K ^TMP("RCDPEFADP",$J),^TMP("RCDPE_ADP",$J)
D COMPILE(INPUTS,.RCVAUTD,.DTOTAL,.GTOTAL) ; Scan AR TRANSACTION file for entries in date range
D DISP(INPUTS,.DTOTAL,.GTOTAL) ; Display Report
K ^TMP("RCDPEFADP",$J),^TMP("RCSELPAY",$J) ; Clear ^TMP global
D ^%ZISC ; Close device
Q
;
COMPILE(INPUTS,RCVAUTD,DTOTAL,GTOTAL) ;EP Generate the Auto-Decrease report ^TMP array
; Input: INPUTS - See REPORT for details
; RCVAUTD - Array of Divisions
; Only passed if A1=2
; Output: DTOTAL - Array of totals by Auto-Post Date
; GTOTAL - Grand totals
; ^TMP("RCDPEFADP",$J)- Array of report data, See SAVE for a full description
N AMT,BEG,DAIEN,END,EXCEL,PIEN,RCBILL,RCBILL3,RCCMT,RCCOPAY,RCDT,RCDTI,RCDEBTOR,RCDIEN
N RCSITE,RCTR,RCTRAND,RCTYPE,RCSORT,RCUSER,RC430IEN,STA,STNAM,STNUM,TRANDA,XX
;
S XX=$P(INPUTS,U,4) ; Auto-Post Date range
S PIEN=$P($P(INPUTS,U,7),"|",2) ; Patient IEN filter (if any)
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,5) ; 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
S ^TMP("RCDPE_FAD",$J,"TCNT")=0,^TMP("RCDPE_FAD",$J,"TAMT")=0
;
; 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 RCUSER=$$GET1^DIQ(433,TRANDA_",",42,"E") ; Get user
. . Q:RCUSER'="POSTMASTER" ; Is this auto-decrease?
. . S RCBILL=$$GET1^DIQ(433,TRANDA_",",.03,"E") ; Copay Claim #
. . S RCBILL3=$$GET1^DIQ(433,TRANDA_",",94,"E") ; 3rd Party #
. . I RCBILL3="" Q ; Not a 3rd party offset
. . S XX=$O(^IB("ABIL",RCBILL,0)) ; IEN in file #350
. . S RCCOPAY=$$GET1^DIQ(350,XX_",",.07,"E") ; Copay Amount
. . ;
. . ; Make sure this is first party - DEBTOR is a patient
. . Q:$$GET1^DIQ(340,$$GET1^DIQ(430,RC430IEN_",",9,"I")_",",.01,"I")'["DPT"
. . S RCDEBTOR=$$GET1^DIQ(430,RC430IEN_",",9,"E")
. . S RCDIEN=$$GET1^DIQ(430,RC430IEN_",",9,"I") ; IEN of file #340
. . S RCDIEN=$P($$GET1^DIQ(340,RCDIEN_",",.01,"I"),";",1) ; IEN of the PATIENT DEBTOR
. . I PIEN'="",RCDIEN'=PIEN Q ; Not the selected patient
. . S RCDEBTOR=$E($$GET1^DIQ(2,RCDIEN_",",.01,"E"),1,23)
. . S RCDEBTOR=RCDEBTOR_"/"_$E($$GET1^DIQ(2,RCDIEN_",",.09,"E"),6,9)
. . S RCDTI=$$GET1^DIQ(433,TRANDA_",",11,"I") ; Transaction date
. . S RCDT=$$FMTE^XLFDT(RCDTI,"2SZ") ; Transaction date Externam
. . S RCAMT=$$GET1^DIQ(433,TRANDA_",",15,"E") ; Transaction amount
. . D DIV(RC430IEN,.STNUM,.STNAM) ; Station name/number
. . S RCCMT=$$GET1^DIQ(433,TRANDA_",",41,,"RCCMT") ; PRCA*4.5*349 - Comments
. . D SAVE(RCDEBTOR,RCAMT,RCBILL,RCBILL3,RCCOPAY,RCDTI,RCDT,EXCEL,RCSORT,.RCTR,STNAM,STNUM,.RCCMT)
Q
;
SAVE(RCDEBTOR,RCAMT,RCBILL,RCBILL3,RCOPAY,RCDTI,RCDT,EXCEL,RCSORT,RCTR,STNAM,STNUM,RCCMT) ; Put data into ^TMP
; Input: RCDEBTOR - Patient Name
; RCAMT - Auto-Decrease amount
; RCBILL - Copay Claim #
; RCBILL3 - 3rd Party Claim #
; RCCOPAY - Copay Amount
; RCDTI - Auto-decrease date (internal)
; RCDT - Auto-decrease date (external)
; EXCEL - 1 output to Excel, 0 otherwise
; RCSORT - C - Sort by Claim, N - Sort by Patient Name
; DTOTAL() - Current array of totals by Auto-Decrease Date
; GTOTAL - Current Grand total
; RCTR - Record Counter
; STNAM - Station name
; STNUM - Station number
; RCCMT - PRCA*4.5*349 - Comments
; ^TMP("RCDPEFADP",$J)- Current report data
; See below for a full description
; Output: DTOTAL() - Updated array of totals by Auto-Post Date
; GTOTAL - Updated Grand totals
; RCTR - Record Counter
; ^TMP("RCDPEFADP",$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,
; Patient Name if sort by Name
; A3 - Record Counter
; B1 - External Station Name
; B2 - External Station Number
; B3 - External Patient Name/SSN
; B4 - Copay Amount
; B5 - Auto-Decrease Amount
; B6 - Copay Bill Number
; B7 - 3rd Party Bill Number
; B8 - Auto-Decrease Date
; ^TMP("RCDPEFADP",$J,A1,A2,A3,"CMT") = Multi-line comment added for PRCA*4.5*349
N A1,A2,XX,CNT
S RCTR=RCTR+1
;
; If EXCEL sorting is done in EXCEL
I EXCEL=1 D
. S A1="EXCEL",A2=$G(^TMP("RCDPEFADP",$J,A1))+1
. S ^TMP("RCDPEFADP",$J,A1)=A2
;
; Otherwise sort by DATE and selected criteria
I 'EXCEL D
. S A1=RCDTI
. S A2=$S($E(RCSORT)="C":RCBILL,1:RCDEBTOR)
;
; Update ^TMP gif claim level adjustments found for this claim
S XX=STNAM_U_STNUM_U_RCDEBTOR_U_RCOPAY_U_RCAMT_U_RCBILL_U_RCBILL3_U_RCDT
S ^TMP("RCDPEFADP",$J,A1,A2,RCTR)=XX ; Claim Information
; PRCA*4.5*349 Begin modified block - Add comments to ^TMP
Q:$D(RCCMT)<9
S XX="",CNT=0 F S XX=$O(RCCMT(XX)) Q:'XX D
. S CNT=CNT+1
. S ^TMP("RCDPEFADP",$J,A1,A2,RCTR,"CMT",CNT)=RCCMT(XX)
; PRCA*4.5*349 End modified block
;
; Update totals for date
S $P(DTOTAL(RCDTI),U,1)=$P($G(DTOTAL(RCDTI)),U,1)+1
S $P(DTOTAL(RCDTI),U,2)=$P($G(DTOTAL(RCDTI)),U,2)+RCAMT
S $P(DTOTAL(RCDTI),U,3)=$P($G(DTOTAL(RCDTI)),U,3)+RCOPAY ; PRCA*4.5*349
;
; Update totals for date range
S $P(GTOTAL,U,1)=$P($G(GTOTAL),U,1)+1
S $P(GTOTAL,U,2)=$P($G(GTOTAL),U,2)+RCAMT
S $P(GTOTAL,U,3)=$P($G(GTOTAL),U,3)+RCOPAY ; PRCA*4.5*349
Q
;
DISP(INPUTS,DTOTAL,GTOTAL) ; Format the display for screen/printer or MS Excel
; Input: INPUTS - See REPORT for details
; DTOTAL()- Array of totals by Internal Auto-Post date
; GTOTAL - Grand Totals for the selected date period
; ^TMP("RCDPEFADP",$J) - See SAVE for description
N A1,A2,A3,DATA,EXCEL,HDRINFO,LMAN,LCNT,MODE,PAGE,RCRDNUM,STOP,X,Y,DISP
U IO
S EXCEL=$P(INPUTS,U,5)
S LMAN=$P(INPUTS,U,6)
S DISP=$P(INPUTS,U,8) ; PRCA*4.5*349
;
; 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 XX=$P(INPUTS,U,2) ; Sort Type
S HDRINFO("SORT")="Sorted By: "_$S(XX="C":"Claim",XX="P":"Payer",1:"Patient Name")
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") ; PRCA*4.5*349
;
; 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("RCDPEFADP",$J,A1))
. Q:A1=""
. I 'LMAN,DISP="D" D Q:STOP
. . I PAGE D ASK(.STOP,0) Q:STOP ; Output to screen, quit if user wants to
. . D HDR(EXCEL,.HDRINFO,.PAGE) ; Display Header
. S A2=""
. F D Q:(A2="")!STOP
. . S A2=$O(^TMP("RCDPEFADP",$J,A1,A2),MODE)
. . I 'EXCEL,A2="" D TOTALD^RCDPEFA2(LMAN,.HDRINFO,.PAGE,.STOP,A1,.DTOTAL,.LCNT)
. . Q:A2=""
. . Q:DISP="S" ; PRCA*4.5*349 - Skip printing details if summary report
. . S A3=0
. . F D Q:'A3!STOP
. . . S A3=$O(^TMP("RCDPEFADP",$J,A1,A2,A3))
. . . Q:'A3
. . . S DATA=^TMP("RCDPEFADP",$J,A1,A2,A3) ; Auto-Decreased Claim
. . . I EXCEL W !,DATA Q ; Output to Excel
. . . I LMAN D Q
. . . . N RCCMT
. . . . M RCCMT=^TMP("RCDPEFADP",$J,A1,A2,A3,"CMT")
. . . . D LMAN^RCDPEFA2(DATA,INPUT,.RCCMT,.LCNT)
. . . I $Y>(IOSL-4) D Q:STOP ; End of page
. . . . D ASK(.STOP,0)
. . . . Q:STOP
. . . . D HDR(EXCEL,.HDRINFO,.PAGE)
. . . S Y=$P(DATA,U,3) ; Patient Name/SSN last 4
. . . S $E(Y,31)=$J($P(DATA,U,4),6,2) ; COPAY Amount
. . . S $E(Y,39)=$J($P(DATA,U,5),6,2) ; Auto-Decrease Amount
. . . S $E(Y,47)=$E($P(DATA,U,6),1,11) ; Copay Claim #
. . . S $E(Y,60)=$E($P(DATA,U,7),1,11) ; Third Party Claim #
. . . S $E(Y,73)=$P(DATA,U,8) ; Auto-Decrease Date
. . . W !,Y
. . . ; PRCA*4.5*349 Begin Modified Block
. . . I $P($P(INPUTS,U,7),"|",3)=1 D ; Show comment detail?
. . . . W !,?6,"Comment: "
. . . . N CNT
. . . . S CNT="" F S CNT=$O(^TMP("RCDPEFADP",$J,A1,A2,A3,"CMT",CNT)) Q:CNT="" D
. . . . . W ^TMP("RCDPEFADP",$J,A1,A2,A3,"CMT",CNT),!,?11
. . . ; PRCA*4.5*349 End Modified Block
;
; Grand totals
I $D(GTOTAL) D
. I 'STOP,'EXCEL D ; Print grand total if not Excel
. . D TOTALG^RCDPEFA2(LMAN,.HDRINFO,.PAGE,GTOTAL,.STOP,.LCNT)
. I 'EXCEL,'LMAN D ; Report finished
. . W !,$$ENDORPRT^RCDPEARL,!
. . D ASK(.STOP,1)
;
; Null Report
I '$D(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_ADP",$J,LCNT)=$J("",26)_"*** No Records to Print ***",LCNT=LCNT+1
. S ^TMP("RCDPE_ADP",$J,LCNT)=" ",LCNT=LCNT+1
. S ^TMP("RCDPE_ADP",$J,LCNT)=$$ENDORPRT^RCDPEARL
; Close device
I '$D(ZTQUEUED) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
ASK(STOP,TYP) ; Ask to continue, if TYP=1 then prompt to finish
; Input: TYP - 1 - Prompt to finish, 0 Otherwise
; Output: STOP - 1 abort print, 0 otherwise
N DIR,DIROUT,DIRUT,DTOUT,DUOUT
Q:$E(IOST,1,2)'["C-" ; Not a terminal
S:$G(TYP)=1 DIR("A")="Enter RETURN to finish"
S DIR(0)="E"
W !
D ^DIR
I ($D(DIRUT))!($D(DUOUT))!($D(DUOUT)) S STOP=1
Q
;
DIV(STAIEN,STNUM,STNAM) ; Get the station for this ERA
; Input: DAIEN - AR ACCOUNT IEN
; Output: STNUM - Station Number
; STNAM - Station Name
S (STNUM,STNAM)="UNKNOWN"
Q:'STAIEN
S STNAM=$$GET1^DIQ(430,STAIEN_",",12,"E")
S STNUM=$$GET1^DIQ(430,STAIEN_",",12,"I")
Q
;
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^PATIENT^COPAY AMOUNT^DECREASE AMOUNT^"
. W "COPAY BILL #^3RD PARTY BILL #^AUTO DECREASE DATE"
;
S PAGE=PAGE+1
W @IOF
S MSG(1)=" First Party COPAY Auto-Decrease Report "
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 Decrease Applied)"
S MSG(4)=" Date Range: "_HDRINFO("START")_" - "_HDRINFO("END")_XX
S MSG(5)=" "_HDRINFO("SORT")_" "_HDRINFO("DISP") ; PRCA*4.5*349
S MSG(6)=" Copay Decrease Copay 3rd Party"
I 'NOLINE D
. S MSG(7)="Patient Name/SSN Amt Amt Bill# Bill# Date"
. S MSG(8)=$TR($J("",80)," ","-")
D EN^DDIOL(.MSG)
Q
;
HINFO(INPUTS,HDRINFO) ; Get header information
; Input: INPUTS - See REPORT for description
; HDRINFO - Header array for ListMan, passed by ref.
N XX
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 XX=$P(INPUTS,U,2) ; Sort Type
S HDRINFO("SORT")="SORTED BY: "_$S(XX="C":"CLAIM",1:"PATIENT NAME")
S XX=$S($P(INPUTS,U,3)="L":"LAST TO FIRST",1:"FIRST TO LAST")
S HDRINFO("SORT")=HDRINFO("SORT")_" - "_XX
S HDRINFO("SORT")=HDRINFO("SORT")_" DISPLAY: "_$S($P(INPUTS,U,8)="S":"SUMMARY",1:"DETAIL")
;
; Format Division filter
S XX=$P(INPUTS,U,1) ; 1 - All Divisions, 2- selected
S HDRINFO("DIVISIONS")=$S(XX=2:$$LINE(.RCVAUTD),1:"ALL")
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
;
LMOUT(INPUT,RCVAUTD,IO) ; Output report to Listman
; Input: INPUT - see REPORT for description
; RCVAUTD - Array of selected Divisions
; IO - Device array
; Output: ^TMP("RCDPE_LAR",$J,nn) - Array of display lines (no headers)
N HDR,HDRINFO,Z0
D REPORT(INPUT,.RCVAUTD,.IO) ; Get lines to be displayed
D HINFO(INPUT,.HDRINFO)
S HDR("TITLE")="FIRST PARTY AUTO-DECREASE"
S HDR(1)=$J("RUN DATE: ",34)_HDRINFO("RUNDATE")
S Z0="DIVISIONS: "_HDRINFO("DIVISIONS")
S HDR(2)=$S($L(Z0)<75:$J("",75-$L(Z0)\2),1:"")_Z0
S HDR(3)=" DATE RANGE: "_HDRINFO("START")_" - "_HDRINFO("END")_" (DATE DECREASE APPLIED)"
S HDR(4)=$J("",(80-$L(HDRINFO("SORT")))\2)_HDRINFO("SORT")
S HDR(5)=" "
S HDR(6)=" Copay Decrease Copay 3rd Party"
S HDR(7)="Patient Name/SSN Amt Amt Bill# Bill# Date"
D LMRPT^RCDPEARL(.HDR,$NA(^TMP("RCDPE_ADP",$J))) ; Generate ListMan display
K ^TMP("RCDPEFADP",$J),^TMP($J,"RCDPEFADP"),^TMP("RCDPE_ADP",$J)
Q
;
; PRCA*4.5*349 - Subroutine added
PCENT(AMNT,COPAY) ; Return percentage of dollars auto-decreased
Q:COPAY=0 "###"
Q $FN(AMNT/COPAY*100,"",0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEFA1 19279 printed Sep 23, 2025@19:20:37 Page 2
RCDPEFA1 ;AITC/FA - FIRST PARTY AUTO-DECREASE REPORT ; 6/12/19 7:36am
+1 ;;4.5;Accounts Receivable;**345,349**;Mar 20, 1995;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ; Read ^DG(40.8) - IA 417
+4 ; DIVISION^VAUTOMA - IA 664
+5 ;
EN ; entry point for Auto-Decrease Adjustment report [RCDPE FIRST PARTY AUTO-DECREASE]
+1 NEW INPUT,RCVAUTD,DISP
+2 ; Division filter
SET INPUT=$$STADIV^RCDPEFA2(.RCVAUTD)
+3 ; '^' or timeout
if 'INPUT
QUIT
+4 ; PRCA*4.5*349 - Display detailed or summary report
SET DISP=$$DETSUM^RCDPEFA2
+5 if DISP=0
QUIT
+6 SET $PIECE(INPUT,U,8)=DISP
+7 ; '^' or timeout
SET $PIECE(INPUT,U,7)="A"
+8 ;
IF DISP="D"
Begin DoDot:1
+9 ; PRCA*4.5*349 - Filter by Patient or 'ALL'
SET $PIECE(INPUT,U,7)=$$ASKPAT^RCDPEFA2
End DoDot:1
+10 ; '^' or timeout
if $PIECE(INPUT,U,7)=0
QUIT
+11 SET $PIECE(INPUT,U,2)="C"
+12 ; Select Sort Criteria
IF DISP="D"
SET $PIECE(INPUT,U,2)=$$ASKSORT^RCDPEFA2
+13 ; '^' or timeout
if $PIECE(INPUT,U,2)=0
QUIT
+14 SET $PIECE(INPUT,U,3)="F"
+15 ;
IF DISP="D"
Begin DoDot:1
+16 ; Select Sort Order
SET $PIECE(INPUT,U,3)=$$SORTORD^RCDPEFA2($PIECE(INPUT,U,2))
End DoDot:1
+17 ; '^' or timeout
if $PIECE(INPUT,U,3)=0
QUIT
+18 ; Select Date Range for Report
SET $PIECE(INPUT,U,4)=$$DTRNG^RCDPEFA2
+19 ; '^' or timeout
if '$PIECE(INPUT,U,4)
QUIT
+20 SET $PIECE(INPUT,U,4)=$PIECE($PIECE(INPUT,U,4),"|",2,3)
+21 ; Ask to Display in Listman Template
SET $PIECE(INPUT,U,6)=$$ASKLM^RCDPEARL
+22 ; '^' or timeout
if $PIECE(INPUT,U,6)<0
QUIT
+23 ; Compile data and call listman to display
IF $PIECE(INPUT,U,6)=1
Begin DoDot:1
+24 DO LMOUT(INPUT,.RCVAUTD,.IO)
End DoDot:1
QUIT
+25 ; Select Display Type
IF DISP="D"
SET $PIECE(INPUT,U,5)=$$DISPTY^RCDPEFA2
+26 ; '^' or timeout
if $PIECE(INPUT,U,5)=-1
QUIT
+27 ; Display capture information for Excel
IF $PIECE(INPUT,U,5)=1
DO INFO^RCDPEM6
+28 ; Ask output device
if '$$DEVICE^RCDPEFA2(.IO)
QUIT
+29 ;
+30 ; Compile and Display Report data (queued) - not allowed for EXCEL
+31 IF $PIECE(INPUT,U,5)'=1
IF $DATA(IO("Q"))
Begin DoDot:1
+32 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+33 SET ZTRTN="REPORT^RCDPEFAD(INPUT,.RCVAUTD,.IO)"
+34 SET ZTDESC="EDI LOCKBOX FIRST PARTY AUTO-DECREASE REPORT"
+35 SET ZTSAVE("RC*")=""
SET ZTSAVE("INPUT")=""
SET ZTSAVE("IO*")=""
+36 DO ^%ZTLOAD
+37 WRITE !!,$SELECT($GET(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this job.")
+38 KILL IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+39 ; Create report
DO REPORT(INPUT,.RCVAUTD,.IO)
+40 QUIT
+41 ;
REPORT(INPUTS,RCVAUTD,IO) ;EP Compile and print report
+1 ; Input: INPUTS - A1^A2^A3^...^An Where:
+2 ; A1 - 1 - All divisions selected, 2 - Selected divisions
+3 ; A2 - C - Sort by Claim, N - Sort by Patient Name
+4 ; A3 - F - sort First to Last, L - sort Last to First
+5 ; A4 - B1|B2
+6 ; B1 - Auto-Post Start Date
+7 ; B2 - Auto-Post End Date
+8 ; A5 - 1 - Output to Excel, else 0
+9 ; A6 - 1 - Output to List Manager, else 0
+10 ; A7 - C1|C2
+11 ; C1 - P - Filter list by Patient
+12 ; A - Show all 1st Party Auto-Decreases"
+13 ; C2 - IEN into file #2 (if C1=P, null otherwise)
+14 ; RCVAUTD - Array of selected Divisions, Only passed if A1=2
+15 ; IO - Output Device
+16 NEW DTOTAL,GTOTAL,XX,ZTREQ
+17 USE IO
+18 KILL ^TMP("RCDPEFADP",$JOB),^TMP("RCDPE_ADP",$JOB)
+19 ; Scan AR TRANSACTION file for entries in date range
DO COMPILE(INPUTS,.RCVAUTD,.DTOTAL,.GTOTAL)
+20 ; Display Report
DO DISP(INPUTS,.DTOTAL,.GTOTAL)
+21 ; Clear ^TMP global
KILL ^TMP("RCDPEFADP",$JOB),^TMP("RCSELPAY",$JOB)
+22 ; Close device
DO ^%ZISC
+23 QUIT
+24 ;
COMPILE(INPUTS,RCVAUTD,DTOTAL,GTOTAL) ;EP Generate the Auto-Decrease report ^TMP array
+1 ; Input: INPUTS - See REPORT for details
+2 ; RCVAUTD - Array of Divisions
+3 ; Only passed if A1=2
+4 ; Output: DTOTAL - Array of totals by Auto-Post Date
+5 ; GTOTAL - Grand totals
+6 ; ^TMP("RCDPEFADP",$J)- Array of report data, See SAVE for a full description
+7 NEW AMT,BEG,DAIEN,END,EXCEL,PIEN,RCBILL,RCBILL3,RCCMT,RCCOPAY,RCDT,RCDTI,RCDEBTOR,RCDIEN
+8 NEW RCSITE,RCTR,RCTRAND,RCTYPE,RCSORT,RCUSER,RC430IEN,STA,STNAM,STNUM,TRANDA,XX
+9 ;
+10 ; Auto-Post Date range
SET XX=$PIECE(INPUTS,U,4)
+11 ; Patient IEN filter (if any)
SET PIEN=$PIECE($PIECE(INPUTS,U,7),"|",2)
+12 SET BEG=$$FMADD^XLFDT($PIECE(XX,"|",1),-1)
+13 ; Auto-Post End Date
SET END=$PIECE(XX,"|",2)
+14 ; Record counter
SET RCTR=0
+15 ; 1 output to Excel, 0 otherwise
SET EXCEL=$PIECE(INPUTS,U,5)
+16 ; Sort Type
SET RCSORT=$PIECE(INPUTS,U,2)
+17 ;
+18 ; Scan index for auto-posted claim lines within the ERA
+19 ; and Save claim line detail to ^TMP global
+20 SET ^TMP("RCDPE_FAD",$JOB,"TCNT")=0
SET ^TMP("RCDPE_FAD",$JOB,"TAMT")=0
+21 ;
+22 ; Get IEN of 'DECREASE ADJUSTMENT' fron #430.3
+23 SET DAIEN=$ORDER(^PRCA(430.3,"B","DECREASE ADJUSTMENT",""))
+24 ;
+25 ; Scan AR Transaction date index for days
+26 SET RCTRAND=BEG
+27 FOR
SET RCTRAND=$ORDER(^PRCA(433,"AT",DAIEN,RCTRAND))
if 'RCTRAND!(RCTRAND>END)
QUIT
Begin DoDot:1
+28 ;
+29 ; Scan AR transactions
+30 SET TRANDA=""
+31 FOR
SET TRANDA=$ORDER(^PRCA(433,"AT",DAIEN,RCTRAND,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:2
+32 ; Get AR ACCOUNT
SET RC430IEN=$$GET1^DIQ(433,TRANDA_",",.03,"I")
+33 if 'RC430IEN
QUIT
+34 ; Get SITE ien
SET RCSITE=$$GET1^DIQ(430,RC430IEN_",",12,"I")
+35 if 'RCSITE
QUIT
+36 ;
+37 ; Ignore transaction if not a selected Division
+38 IF $PIECE(INPUTS,U,1)=2
IF '$DATA(RCVAUTD(RCSITE))
QUIT
+39 ; Get user
SET RCUSER=$$GET1^DIQ(433,TRANDA_",",42,"E")
+40 ; Is this auto-decrease?
if RCUSER'="POSTMASTER"
QUIT
+41 ; Copay Claim #
SET RCBILL=$$GET1^DIQ(433,TRANDA_",",.03,"E")
+42 ; 3rd Party #
SET RCBILL3=$$GET1^DIQ(433,TRANDA_",",94,"E")
+43 ; Not a 3rd party offset
IF RCBILL3=""
QUIT
+44 ; IEN in file #350
SET XX=$ORDER(^IB("ABIL",RCBILL,0))
+45 ; Copay Amount
SET RCCOPAY=$$GET1^DIQ(350,XX_",",.07,"E")
+46 ;
+47 ; Make sure this is first party - DEBTOR is a patient
+48 if $$GET1^DIQ(340,$$GET1^DIQ(430,RC430IEN_",",9,"I")_",",.01,"I")'["DPT"
QUIT
+49 SET RCDEBTOR=$$GET1^DIQ(430,RC430IEN_",",9,"E")
+50 ; IEN of file #340
SET RCDIEN=$$GET1^DIQ(430,RC430IEN_",",9,"I")
+51 ; IEN of the PATIENT DEBTOR
SET RCDIEN=$PIECE($$GET1^DIQ(340,RCDIEN_",",.01,"I"),";",1)
+52 ; Not the selected patient
IF PIEN'=""
IF RCDIEN'=PIEN
QUIT
+53 SET RCDEBTOR=$EXTRACT($$GET1^DIQ(2,RCDIEN_",",.01,"E"),1,23)
+54 SET RCDEBTOR=RCDEBTOR_"/"_$EXTRACT($$GET1^DIQ(2,RCDIEN_",",.09,"E"),6,9)
+55 ; Transaction date
SET RCDTI=$$GET1^DIQ(433,TRANDA_",",11,"I")
+56 ; Transaction date Externam
SET RCDT=$$FMTE^XLFDT(RCDTI,"2SZ")
+57 ; Transaction amount
SET RCAMT=$$GET1^DIQ(433,TRANDA_",",15,"E")
+58 ; Station name/number
DO DIV(RC430IEN,.STNUM,.STNAM)
+59 ; PRCA*4.5*349 - Comments
SET RCCMT=$$GET1^DIQ(433,TRANDA_",",41,,"RCCMT")
+60 DO SAVE(RCDEBTOR,RCAMT,RCBILL,RCBILL3,RCCOPAY,RCDTI,RCDT,EXCEL,RCSORT,.RCTR,STNAM,STNUM,.RCCMT)
End DoDot:2
End DoDot:1
+61 QUIT
+62 ;
SAVE(RCDEBTOR,RCAMT,RCBILL,RCBILL3,RCOPAY,RCDTI,RCDT,EXCEL,RCSORT,RCTR,STNAM,STNUM,RCCMT) ; Put data into ^TMP
+1 ; Input: RCDEBTOR - Patient Name
+2 ; RCAMT - Auto-Decrease amount
+3 ; RCBILL - Copay Claim #
+4 ; RCBILL3 - 3rd Party Claim #
+5 ; RCCOPAY - Copay Amount
+6 ; RCDTI - Auto-decrease date (internal)
+7 ; RCDT - Auto-decrease date (external)
+8 ; EXCEL - 1 output to Excel, 0 otherwise
+9 ; RCSORT - C - Sort by Claim, N - Sort by Patient Name
+10 ; DTOTAL() - Current array of totals by Auto-Decrease Date
+11 ; GTOTAL - Current Grand total
+12 ; RCTR - Record Counter
+13 ; STNAM - Station name
+14 ; STNUM - Station number
+15 ; RCCMT - PRCA*4.5*349 - Comments
+16 ; ^TMP("RCDPEFADP",$J)- Current report data
+17 ; See below for a full description
+18 ; Output: DTOTAL() - Updated array of totals by Auto-Post Date
+19 ; GTOTAL - Updated Grand totals
+20 ; RCTR - Record Counter
+21 ; ^TMP("RCDPEFADP",$J,A1,A2,A3) = B1^B2^B3^...^Bn Where:
+22 ; A1 - "EXCEL" if report to excel, fileman date if not
+23 ; A2 - Excel Line Counter if to excel, Claim # if sort by claim,
+24 ; Patient Name if sort by Name
+25 ; A3 - Record Counter
+26 ; B1 - External Station Name
+27 ; B2 - External Station Number
+28 ; B3 - External Patient Name/SSN
+29 ; B4 - Copay Amount
+30 ; B5 - Auto-Decrease Amount
+31 ; B6 - Copay Bill Number
+32 ; B7 - 3rd Party Bill Number
+33 ; B8 - Auto-Decrease Date
+34 ; ^TMP("RCDPEFADP",$J,A1,A2,A3,"CMT") = Multi-line comment added for PRCA*4.5*349
+35 NEW A1,A2,XX,CNT
+36 SET RCTR=RCTR+1
+37 ;
+38 ; If EXCEL sorting is done in EXCEL
+39 IF EXCEL=1
Begin DoDot:1
+40 SET A1="EXCEL"
SET A2=$GET(^TMP("RCDPEFADP",$JOB,A1))+1
+41 SET ^TMP("RCDPEFADP",$JOB,A1)=A2
End DoDot:1
+42 ;
+43 ; Otherwise sort by DATE and selected criteria
+44 IF 'EXCEL
Begin DoDot:1
+45 SET A1=RCDTI
+46 SET A2=$SELECT($EXTRACT(RCSORT)="C":RCBILL,1:RCDEBTOR)
End DoDot:1
+47 ;
+48 ; Update ^TMP gif claim level adjustments found for this claim
+49 SET XX=STNAM_U_STNUM_U_RCDEBTOR_U_RCOPAY_U_RCAMT_U_RCBILL_U_RCBILL3_U_RCDT
+50 ; Claim Information
SET ^TMP("RCDPEFADP",$JOB,A1,A2,RCTR)=XX
+51 ; PRCA*4.5*349 Begin modified block - Add comments to ^TMP
+52 if $DATA(RCCMT)<9
QUIT
+53 SET XX=""
SET CNT=0
FOR
SET XX=$ORDER(RCCMT(XX))
if 'XX
QUIT
Begin DoDot:1
+54 SET CNT=CNT+1
+55 SET ^TMP("RCDPEFADP",$JOB,A1,A2,RCTR,"CMT",CNT)=RCCMT(XX)
End DoDot:1
+56 ; PRCA*4.5*349 End modified block
+57 ;
+58 ; Update totals for date
+59 SET $PIECE(DTOTAL(RCDTI),U,1)=$PIECE($GET(DTOTAL(RCDTI)),U,1)+1
+60 SET $PIECE(DTOTAL(RCDTI),U,2)=$PIECE($GET(DTOTAL(RCDTI)),U,2)+RCAMT
+61 ; PRCA*4.5*349
SET $PIECE(DTOTAL(RCDTI),U,3)=$PIECE($GET(DTOTAL(RCDTI)),U,3)+RCOPAY
+62 ;
+63 ; Update totals for date range
+64 SET $PIECE(GTOTAL,U,1)=$PIECE($GET(GTOTAL),U,1)+1
+65 SET $PIECE(GTOTAL,U,2)=$PIECE($GET(GTOTAL),U,2)+RCAMT
+66 ; PRCA*4.5*349
SET $PIECE(GTOTAL,U,3)=$PIECE($GET(GTOTAL),U,3)+RCOPAY
+67 QUIT
+68 ;
DISP(INPUTS,DTOTAL,GTOTAL) ; Format the display for screen/printer or MS Excel
+1 ; Input: INPUTS - See REPORT for details
+2 ; DTOTAL()- Array of totals by Internal Auto-Post date
+3 ; GTOTAL - Grand Totals for the selected date period
+4 ; ^TMP("RCDPEFADP",$J) - See SAVE for description
+5 NEW A1,A2,A3,DATA,EXCEL,HDRINFO,LMAN,LCNT,MODE,PAGE,RCRDNUM,STOP,X,Y,DISP
+6 USE IO
+7 SET EXCEL=$PIECE(INPUTS,U,5)
+8 SET LMAN=$PIECE(INPUTS,U,6)
+9 ; PRCA*4.5*349
SET DISP=$PIECE(INPUTS,U,8)
+10 ;
+11 ; Header information
+12 ; Auto-Post Date range
SET XX=$PIECE(INPUTS,U,4)
+13 SET HDRINFO("START")=$$FMTE^XLFDT($PIECE(XX,"|",1),"2SZ")
+14 SET HDRINFO("END")=$$FMTE^XLFDT($PIECE(XX,"|",2),"2SZ")
+15 SET HDRINFO("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ")
+16 ; Sort Type
SET XX=$PIECE(INPUTS,U,2)
+17 SET HDRINFO("SORT")="Sorted By: "_$SELECT(XX="C":"Claim",XX="P":"Payer",1:"Patient Name")
+18 SET XX=$SELECT($PIECE(INPUTS,U,3)="L":"Last to First",1:"First to Last")
+19 SET HDRINFO("SORT")=HDRINFO("SORT")_" - "_XX
+20 ; PRCA*4.5*349
SET HDRINFO("DISP")="Display: "_$SELECT(DISP="S":"SUMMARY",1:"DETAIL")
+21 ;
+22 ; Format Division filter
+23 ; XX=1 - All Divisions, 2- selected
SET XX=$PIECE(INPUTS,U,1)
+24 SET HDRINFO("DIVISIONS")=$SELECT(XX=2:$$LINE(.RCVAUTD),1:"ALL")
+25 ;
+26 SET A1=""
SET PAGE=0
SET STOP=0
SET LCNT=1
+27 IF 'LMAN
IF DISP="S"
DO HDR(EXCEL,.HDRINFO,.PAGE)
+28 ; Mode for $ORDER
SET MODE=$SELECT($PIECE(INPUTS,U,3)="L":-1,1:1)
+29 FOR
Begin DoDot:1
+30 SET A1=$ORDER(^TMP("RCDPEFADP",$JOB,A1))
+31 if A1=""
QUIT
+32 IF 'LMAN
IF DISP="D"
Begin DoDot:2
+33 ; Output to screen, quit if user wants to
IF PAGE
DO ASK(.STOP,0)
if STOP
QUIT
+34 ; Display Header
DO HDR(EXCEL,.HDRINFO,.PAGE)
End DoDot:2
if STOP
QUIT
+35 SET A2=""
+36 FOR
Begin DoDot:2
+37 SET A2=$ORDER(^TMP("RCDPEFADP",$JOB,A1,A2),MODE)
+38 IF 'EXCEL
IF A2=""
DO TOTALD^RCDPEFA2(LMAN,.HDRINFO,.PAGE,.STOP,A1,.DTOTAL,.LCNT)
+39 if A2=""
QUIT
+40 ; PRCA*4.5*349 - Skip printing details if summary report
if DISP="S"
QUIT
+41 SET A3=0
+42 FOR
Begin DoDot:3
+43 SET A3=$ORDER(^TMP("RCDPEFADP",$JOB,A1,A2,A3))
+44 if 'A3
QUIT
+45 ; Auto-Decreased Claim
SET DATA=^TMP("RCDPEFADP",$JOB,A1,A2,A3)
+46 ; Output to Excel
IF EXCEL
WRITE !,DATA
QUIT
+47 IF LMAN
Begin DoDot:4
+48 NEW RCCMT
+49 MERGE RCCMT=^TMP("RCDPEFADP",$JOB,A1,A2,A3,"CMT")
+50 DO LMAN^RCDPEFA2(DATA,INPUT,.RCCMT,.LCNT)
End DoDot:4
QUIT
+51 ; End of page
IF $Y>(IOSL-4)
Begin DoDot:4
+52 DO ASK(.STOP,0)
+53 if STOP
QUIT
+54 DO HDR(EXCEL,.HDRINFO,.PAGE)
End DoDot:4
if STOP
QUIT
+55 ; Patient Name/SSN last 4
SET Y=$PIECE(DATA,U,3)
+56 ; COPAY Amount
SET $EXTRACT(Y,31)=$JUSTIFY($PIECE(DATA,U,4),6,2)
+57 ; Auto-Decrease Amount
SET $EXTRACT(Y,39)=$JUSTIFY($PIECE(DATA,U,5),6,2)
+58 ; Copay Claim #
SET $EXTRACT(Y,47)=$EXTRACT($PIECE(DATA,U,6),1,11)
+59 ; Third Party Claim #
SET $EXTRACT(Y,60)=$EXTRACT($PIECE(DATA,U,7),1,11)
+60 ; Auto-Decrease Date
SET $EXTRACT(Y,73)=$PIECE(DATA,U,8)
+61 WRITE !,Y
+62 ; PRCA*4.5*349 Begin Modified Block
+63 ; Show comment detail?
IF $PIECE($PIECE(INPUTS,U,7),"|",3)=1
Begin DoDot:4
+64 WRITE !,?6,"Comment: "
+65 NEW CNT
+66 SET CNT=""
FOR
SET CNT=$ORDER(^TMP("RCDPEFADP",$JOB,A1,A2,A3,"CMT",CNT))
if CNT=""
QUIT
Begin DoDot:5
+67 WRITE ^TMP("RCDPEFADP",$JOB,A1,A2,A3,"CMT",CNT),!,?11
End DoDot:5
End DoDot:4
+68 ; PRCA*4.5*349 End Modified Block
End DoDot:3
if 'A3!STOP
QUIT
End DoDot:2
if (A2="")!STOP
QUIT
End DoDot:1
if (A1="")!STOP
QUIT
+69 ;
+70 ; Grand totals
+71 IF $DATA(GTOTAL)
Begin DoDot:1
+72 ; Print grand total if not Excel
IF 'STOP
IF 'EXCEL
Begin DoDot:2
+73 DO TOTALG^RCDPEFA2(LMAN,.HDRINFO,.PAGE,GTOTAL,.STOP,.LCNT)
End DoDot:2
+74 ; Report finished
IF 'EXCEL
IF 'LMAN
Begin DoDot:2
+75 WRITE !,$$ENDORPRT^RCDPEARL,!
+76 DO ASK(.STOP,1)
End DoDot:2
End DoDot:1
+77 ;
+78 ; Null Report
+79 IF '$DATA(GTOTAL)
IF 'LMAN
Begin DoDot:1
+80 IF PAGE=0
DO HDR(EXCEL,.HDRINFO,.PAGE)
+81 WRITE !!,?26,"*** No Records to Print ***",!
+82 WRITE !,$$ENDORPRT^RCDPEARL
+83 if '$DATA(ZTQUEUED)
SET X=$$ASKSTOP^RCDPELAR
End DoDot:1
+84 ;
+85 ; List manager
+86 IF LMAN
Begin DoDot:1
+87 if LCNT=1
SET ^TMP("RCDPE_ADP",$JOB,LCNT)=$JUSTIFY("",26)_"*** No Records to Print ***"
SET LCNT=LCNT+1
+88 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=" "
SET LCNT=LCNT+1
+89 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=$$ENDORPRT^RCDPEARL
End DoDot:1
+90 ; Close device
+91 IF '$DATA(ZTQUEUED)
DO ^%ZISC
+92 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+93 QUIT
+94 ;
ASK(STOP,TYP) ; Ask to continue, if TYP=1 then prompt to finish
+1 ; Input: TYP - 1 - Prompt to finish, 0 Otherwise
+2 ; Output: STOP - 1 abort print, 0 otherwise
+3 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT
+4 ; Not a terminal
if $EXTRACT(IOST,1,2)'["C-"
QUIT
+5 if $GET(TYP)=1
SET DIR("A")="Enter RETURN to finish"
+6 SET DIR(0)="E"
+7 WRITE !
+8 DO ^DIR
+9 IF ($DATA(DIRUT))!($DATA(DUOUT))!($DATA(DUOUT))
SET STOP=1
+10 QUIT
+11 ;
DIV(STAIEN,STNUM,STNAM) ; Get the station for this ERA
+1 ; Input: DAIEN - AR ACCOUNT IEN
+2 ; Output: STNUM - Station Number
+3 ; STNAM - Station Name
+4 SET (STNUM,STNAM)="UNKNOWN"
+5 if 'STAIEN
QUIT
+6 SET STNAM=$$GET1^DIQ(430,STAIEN_",",12,"E")
+7 SET STNUM=$$GET1^DIQ(430,STAIEN_",",12,"I")
+8 QUIT
+9 ;
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^PATIENT^COPAY AMOUNT^DECREASE AMOUNT^"
+11 WRITE "COPAY BILL #^3RD PARTY BILL #^AUTO DECREASE DATE"
End DoDot:1
QUIT
+12 ;
+13 SET PAGE=PAGE+1
+14 WRITE @IOF
+15 SET MSG(1)=" First Party COPAY Auto-Decrease Report "
+16 SET MSG(1)=MSG(1)_" Page: "_PAGE
+17 SET MSG(2)=" Run Date: "_HDRINFO("RUNDATE")
+18 SET Z0="Divisions: "_HDRINFO("DIVISIONS")
+19 SET MSG(3)=$SELECT($LENGTH(Z0)<75:$JUSTIFY("",75-$LENGTH(Z0)\2),1:"")_Z0
+20 SET XX=" (Date Decrease Applied)"
+21 SET MSG(4)=" Date Range: "_HDRINFO("START")_" - "_HDRINFO("END")_XX
+22 ; PRCA*4.5*349
SET MSG(5)=" "_HDRINFO("SORT")_" "_HDRINFO("DISP")
+23 SET MSG(6)=" Copay Decrease Copay 3rd Party"
+24 IF 'NOLINE
Begin DoDot:1
+25 SET MSG(7)="Patient Name/SSN Amt Amt Bill# Bill# Date"
+26 SET MSG(8)=$TRANSLATE($JUSTIFY("",80)," ","-")
End DoDot:1
+27 DO EN^DDIOL(.MSG)
+28 QUIT
+29 ;
HINFO(INPUTS,HDRINFO) ; Get header information
+1 ; Input: INPUTS - See REPORT for description
+2 ; HDRINFO - Header array for ListMan, passed by ref.
+3 NEW XX
+4 ; Auto-Post Date range
SET XX=$PIECE(INPUTS,U,4)
+5 SET HDRINFO("START")=$$FMTE^XLFDT($PIECE(XX,"|",1),"2SZ")
+6 SET HDRINFO("END")=$$FMTE^XLFDT($PIECE(XX,"|",2),"2SZ")
+7 SET HDRINFO("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ")
+8 ; Sort Type
SET XX=$PIECE(INPUTS,U,2)
+9 SET HDRINFO("SORT")="SORTED BY: "_$SELECT(XX="C":"CLAIM",1:"PATIENT NAME")
+10 SET XX=$SELECT($PIECE(INPUTS,U,3)="L":"LAST TO FIRST",1:"FIRST TO LAST")
+11 SET HDRINFO("SORT")=HDRINFO("SORT")_" - "_XX
+12 SET HDRINFO("SORT")=HDRINFO("SORT")_" DISPLAY: "_$SELECT($PIECE(INPUTS,U,8)="S":"SUMMARY",1:"DETAIL")
+13 ;
+14 ; Format Division filter
+15 ; 1 - All Divisions, 2- selected
SET XX=$PIECE(INPUTS,U,1)
+16 SET HDRINFO("DIVISIONS")=$SELECT(XX=2:$$LINE(.RCVAUTD),1:"ALL")
+17 QUIT
+18 ;
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 ;
LMOUT(INPUT,RCVAUTD,IO) ; Output report to Listman
+1 ; Input: INPUT - see REPORT for description
+2 ; RCVAUTD - Array of selected Divisions
+3 ; IO - Device array
+4 ; Output: ^TMP("RCDPE_LAR",$J,nn) - Array of display lines (no headers)
+5 NEW HDR,HDRINFO,Z0
+6 ; Get lines to be displayed
DO REPORT(INPUT,.RCVAUTD,.IO)
+7 DO HINFO(INPUT,.HDRINFO)
+8 SET HDR("TITLE")="FIRST PARTY AUTO-DECREASE"
+9 SET HDR(1)=$JUSTIFY("RUN DATE: ",34)_HDRINFO("RUNDATE")
+10 SET Z0="DIVISIONS: "_HDRINFO("DIVISIONS")
+11 SET HDR(2)=$SELECT($LENGTH(Z0)<75:$JUSTIFY("",75-$LENGTH(Z0)\2),1:"")_Z0
+12 SET HDR(3)=" DATE RANGE: "_HDRINFO("START")_" - "_HDRINFO("END")_" (DATE DECREASE APPLIED)"
+13 SET HDR(4)=$JUSTIFY("",(80-$LENGTH(HDRINFO("SORT")))\2)_HDRINFO("SORT")
+14 SET HDR(5)=" "
+15 SET HDR(6)=" Copay Decrease Copay 3rd Party"
+16 SET HDR(7)="Patient Name/SSN Amt Amt Bill# Bill# Date"
+17 ; Generate ListMan display
DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP("RCDPE_ADP",$JOB)))
+18 KILL ^TMP("RCDPEFADP",$JOB),^TMP($JOB,"RCDPEFADP"),^TMP("RCDPE_ADP",$JOB)
+19 QUIT
+20 ;
+21 ; PRCA*4.5*349 - Subroutine added
PCENT(AMNT,COPAY) ; Return percentage of dollars auto-decreased
+1 if COPAY=0
QUIT "###"
+2 QUIT $FNUMBER(AMNT/COPAY*100,"",0)
