RCDPEFA1.m

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 ---RCDPEFA1   19279     printed  Feb 18, 2025@23:10:59                                                                                                                                                                                                   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