RCDPEFA2 ;AITC/FA - FIRST PARTY AUTO-DECREASE REPORT, cont. ; 5/29/19 12:31pm
;;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
;
Q
;
STADIV(RCVAUTD) ; EP from RCDPEFA1 - Division/Station selection
; Input: None
; Output: RCVAUTD - Array of selected Divisions/Stations, passed by ref.
; Returns: 1 - All selected, 2 - specific Divisions/Stations, 0 - U or timeout
N DTOUT,DUOUT,VAUTD,Y
D DIVISION^VAUTOMA ; RETURNS Y=-1 (quit), VAUTD=1 (for all),VAUTD=0 (selected divisions in VAUTD) - IA 664
Q:Y<0 0
Q:VAUTD=1 1 ; All Divisions
S Y="" F S Y=$O(VAUTD(Y)) Q:'Y D ;
. I $G(^DG(40.8,"ADV",Y)) S RCVAUTD(^DG(40.8,"ADV",Y))=VAUTD(Y)
Q 2
;
ASKPAT() ; EP from RCDPEFA1 - Filter by Patient or 'ALL'
; Input: None
; Returns: P - Sort by Claim
; A - Sort by Patient Name
; 0 - User entered '^' or timed out
N C1,C2,C3,DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX
S DIR(0)="SA^P:PATIENT;A:ALL;"
S DIR("A")="Select (P)ATIENT or (A)LL?: "
S DIR("?",1)="Enter 'P' to filter by Patient or 'A' to show all 1st Party"
S DIR("?")="Auto-Decreases."
S DIR("B")="ALL"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) 0
S C1=Y,C2="",C3="" ; PRCA*4.5*349 add C3
S:C1="P" C2=$$ASKPAT2 ; Ask for Patient IEN
Q:C2=0 0 ; No patient selected
Q:C2=0 C1_"|"
; PRCA*4.5*349 Begin Modified Block
S:+C2 C3=$$ASKPAT3
Q:C3=-1 0
Q C1_"|"_C2_"|"_C3
; PRCA*4.5*349 End Modified Block
;
ASKPAT2() ; Select the Patient to filter by
; Input: None
; Returns: IEN - Select Patient IEN file #2
; 0 - User entered '^' or timed out or no patient selected
N DIC,DIROUT,DIRUT,DTOUT,DUOUT
S DIC="^DPT(",DIC(0)="AEINMQ"
S DIC("A")="Select Patient: "
D ^DIC
Q:$D(DTOUT)!$D(DUOUT) 0
Q:Y<1 0
Q:Y="" 0
Q $P(Y,U,1)
;
; prca*4.5*349 - Subroutine added
ASKPAT3() ; Ask whether to display comment details for single patient search
; Input: None
; Returns: Y = Yes, display comment details
; N = No, do not display comment details
; -1 = User entered '^' or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
S DIR(0)="YA"
S DIR("A")="Display Comment Detail? (Y/N)// "
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q -1
Q Y
;
ASKSORT() ; EP from RCDPEFA1 - Select the sort criteria
; Input: None
; Returns: C - Sort by Claim
; N - Sort by Patient Name
; 0 - User entered '^' or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX
S DIR(0)="SA^C:CLAIM;N:PATIENT NAME;"
S DIR("A")="Sort by (C)LAIM # or PATIENT (N)AME?: "
S DIR("?",1)="Enter 'C' to sort by Claim Number or 'N' to sort"
S DIR("?")="by Patient Name."
S DIR("B")="CLAIM"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) 0
Q Y
;
SORTORD(SORT) ; EP from RCDPEFA1 - Select the sort order
; Input: SORT - 'C' - Sort by Claim Number
; 'N' - Sort by Patient Name
; Returns: F - First to Last
; L - Last to First
; 0 - User entered '^' or timed out
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX,YY
S XX=" (F)IRST TO LAST or (L)AST TO FIRST?: "
S YY=$S(SORT="C":"CLAIM",1:"PATIENT NAME")
S DIR("A")="Sort "_YY_XX
S DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST"
S DIR("B")="FIRST TO LAST"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) 0
Q Y
;
DTRNG() ; EP from RCDPEFA1 - Get the date range for the report
; Input: None
; Returns: A1|A2|A3 - Where:
; A1 - 0 - User up-arrowed or timed out, 1 otherwise
; A2 - Auto-Post Start Date
; A3 - Auto-Post End Date
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCEND,RCSTART,RNGFLG,X,Y
D DATES(.RCSTART,.RCEND)
Q:RCSTART=-1 0
Q:RCSTART "1|"_RCSTART_"|"_RCEND
Q:'RCSTART "0||"
Q 0
;
DATES(BDATE,EDATE) ; Get a date range.
; Input: None
; Output: BDATE - Internal Auto-Post Start Date
; EDATE - Internal Auto-Post End Date
D1 ; looping tag
S (BDATE,EDATE)=0
S DIR("?")="Enter the earliest Auto-Posting date to include on the report."
S DIR(0)="DAO^:"_DT_":APE"
S DIR("A")="Start Date: "
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q
S BDATE=Y
S DIR("?")="Enter the latest Auto-Posting date to include on the report."
S DIR("B")=Y(0)
S DIR(0)="DAO^"_BDATE_":"_DT_":APE"
S DIR("A")="End Date: "
D ^DIR
K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q
S EDATE=Y
Q
;
DISPTY() ; EP from RCDPEFA1 - Get display/output type
; Input: None
; Returns: 1 - Output to Excel
; 0 - Output to paper
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
S DIR(0)="Y"
S DIR("A")="Export the report to Microsoft Excel"
S DIR("B")="NO"
D ^DIR
I $G(DUOUT) Q -1
Q Y
;
; PRCA*4.5*349 - Subroutine added
DETSUM() ; EP from RCDPEFA1 - Get detail/summary type
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
S DIR("A")="Display (S)UMMARY or (D)ETAIL Format?: "
S DIR(0)="SA^S:SUMMARY;D:DETAIL"
S DIR("B")="DETAIL"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT) 0
Q Y
;
DEVICE(IO) ; Select output device
; Input: None
; Output: IO - Array of selected output info
; Returns: 0 - No device selected, 1 Otherwise
N POP,%ZIS
S %ZIS="QM"
D ^%ZIS
Q:POP 0
Q 1
;
LMAN(DATA,INPUT,RCCMT,XX) ;EP from RCDPEFA1
; Format and save List Manager line
; Input: DATA - ERA line adjustment total
; INPUT - Input parameters in delimited list
; RCCMT - Array of free text comments for this decrease
; XX - List Counter for ^TMP("RCDPE_ADP",$J)
;
N CNT,Y
S Y=$P(DATA,U,3) ; Patient Name/SSN last 4
S $E(Y,33)=$J($P(DATA,U,4),6,2) ; COPAY Amount
S $E(Y,41)=$J($P(DATA,U,5),6,2) ; Auto-Decrease Amount
S $E(Y,49)=$E($P(DATA,U,6),1,10) ; Copay Claim #
S $E(Y,61)=$E($P(DATA,U,7),1,10) ; 3rd Party Claim #
S $E(Y,73)=$P(DATA,U,8) ; Auto-Decrease Date
S ^TMP("RCDPE_ADP",$J,XX)=Y,XX=XX+1
I $P($P(INPUTS,U,7),"|",3)=1 D ; Show comment detail?
. S CNT="" F S CNT=$O(RCCMT(CNT)) Q:CNT="" D ;
. . S Y=$S(CNT=1:" Comment: ",1:" ")
. . S Y=Y_RCCMT(CNT)
. . S ^TMP("RCDPE_ADP",$J,XX)=Y,XX=XX+1
Q
;
TOTALD(LMAN,HDRINFO,PAGE,STOP,DAY,DTOTAL,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
; DTOTAL - Array of totals by day
; 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,LN3,DCOP
S DCNT=$P(DTOTAL(DAY),U,1)
S DAMT=$P(DTOTAL(DAY),U,2)
S DCOP=$P(DTOTAL(DAY),U,3) ; PRCA*4.5*349
S LN1="**Totals for Date: "_$$FMTE^XLFDT(DAY,"2Z")
S $E(LN1,35)=" # of Decrease Adjustments: "_DCNT
S LN2="",$E(LN2,28)="Total Amount of Decrease Adjustments: $"_$J(DAMT,3,2)
S LN3="",$E(LN3,22)="% of Dollars Auto-Decreased of Total Copay: "_$$PCENT^RCDPEFA1(DAMT,DCOP)_"%" ; PRCA*4.5*349
;
I LMAN D Q
. S ^TMP("RCDPE_ADP",$J,LCNT)="",LCNT=LCNT+1
. S ^TMP("RCDPE_ADP",$J,LCNT)=LN1,LCNT=LCNT+1
. S ^TMP("RCDPE_ADP",$J,LCNT)=LN2,LCNT=LCNT+1
. S ^TMP("RCDPE_ADP",$J,LCNT)=LN3,LCNT=LCNT+1 ; PRCA*4.5*349
. S ^TMP("RCDPE_ADP",$J,LCNT)="",LCNT=LCNT+1
;
I $Y>(IOSL-7) D
. D ASK^RCDPEADP(.STOP,0)
. Q:STOP
. D HDR^RCDPEFA1(EXCEL,.HDRINFO,.PAGE)
Q:STOP
W !!,LN1
W !,LN2
W !,LN3 ; PRCA*4.5*349
Q
;
TOTALG(LMAN,HDRINFO,PAGE,GTOTAL,STOP,LCNT) ; Overall report total
; Input: LMAN - 1 if output to Listman, 0 otherwise
; HDRINFO - Array of header info
; PAGE - Current Page Number
; GTOTAL - Grand Totals for report
; 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 LN1,LN2,LN3,GAMT,GCOP
S GAMT=+$P(GTOTAL,U,2),GCOP=+$P(GTOTAL,U,3) ; PRCA*4.5*349
S LN1="**** Totals for Date Range: # of Decrease Adjustments: "_+$P(GTOTAL,U,1)
S LN2="",$E(LN2,28)="Total Amount of Decrease Adjustments: $"_$J((+$P(GTOTAL,U,2)),3,2)
S LN3="",$E(LN3,22)="% of Dollars Auto-Decreased of Total Copay: "_$$PCENT^RCDPEFA1(GAMT,GCOP)_"%" ; PRCA*4.5*349
;
I LMAN D Q
. S ^TMP("RCDPE_ADP",$J,LCNT)="",LCNT=LCNT+1
. S ^TMP("RCDPE_ADP",$J,LCNT)=LN1,LCNT=LCNT+1
. S ^TMP("RCDPE_ADP",$J,LCNT)=LN2,LCNT=LCNT+1
. S ^TMP("RCDPE_ADP",$J,LCNT)=LN3,LCNT=LCNT+1 ; PRCA*4.5*349
;
I $Y>(IOSL-6) D
. D ASK^RCDPEADP(.STOP,0)
. Q:STOP
. D HDR^RCDPEFA1(EXCEL,.HDRINFO,.PAGE)
Q:STOP
W !!,"**** Totals for Date Range: # of Decrease Adjustments: "_+$P(GTOTAL,U,1)
S Y="",$E(Y,28)="Total Amount of Decrease Adjustments: $"_$J((+$P(GTOTAL,U,2)),3,2)
W !,Y ; PRCA*4.5*349
S Y="",$E(Y,22)="% of Dollars Auto-Decreased of Total Copay: "_$$PCENT^RCDPEFA1(GAMT,GCOP)_"%" ; PRCA*4.5*349
W !,Y,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEFA2 9362 printed Sep 23, 2025@19:20:38 Page 2
RCDPEFA2 ;AITC/FA - FIRST PARTY AUTO-DECREASE REPORT, cont. ; 5/29/19 12:31pm
+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 ;
+6 QUIT
+7 ;
STADIV(RCVAUTD) ; EP from RCDPEFA1 - Division/Station selection
+1 ; Input: None
+2 ; Output: RCVAUTD - Array of selected Divisions/Stations, passed by ref.
+3 ; Returns: 1 - All selected, 2 - specific Divisions/Stations, 0 - U or timeout
+4 NEW DTOUT,DUOUT,VAUTD,Y
+5 ; RETURNS Y=-1 (quit), VAUTD=1 (for all),VAUTD=0 (selected divisions in VAUTD) - IA 664
DO DIVISION^VAUTOMA
+6 if Y<0
QUIT 0
+7 ; All Divisions
if VAUTD=1
QUIT 1
+8 ;
SET Y=""
FOR
SET Y=$ORDER(VAUTD(Y))
if 'Y
QUIT
Begin DoDot:1
+9 IF $GET(^DG(40.8,"ADV",Y))
SET RCVAUTD(^DG(40.8,"ADV",Y))=VAUTD(Y)
End DoDot:1
+10 QUIT 2
+11 ;
ASKPAT() ; EP from RCDPEFA1 - Filter by Patient or 'ALL'
+1 ; Input: None
+2 ; Returns: P - Sort by Claim
+3 ; A - Sort by Patient Name
+4 ; 0 - User entered '^' or timed out
+5 NEW C1,C2,C3,DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX
+6 SET DIR(0)="SA^P:PATIENT;A:ALL;"
+7 SET DIR("A")="Select (P)ATIENT or (A)LL?: "
+8 SET DIR("?",1)="Enter 'P' to filter by Patient or 'A' to show all 1st Party"
+9 SET DIR("?")="Auto-Decreases."
+10 SET DIR("B")="ALL"
+11 DO ^DIR
+12 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+13 ; PRCA*4.5*349 add C3
SET C1=Y
SET C2=""
SET C3=""
+14 ; Ask for Patient IEN
if C1="P"
SET C2=$$ASKPAT2
+15 ; No patient selected
if C2=0
QUIT 0
+16 if C2=0
QUIT C1_"|"
+17 ; PRCA*4.5*349 Begin Modified Block
+18 if +C2
SET C3=$$ASKPAT3
+19 if C3=-1
QUIT 0
+20 QUIT C1_"|"_C2_"|"_C3
+21 ; PRCA*4.5*349 End Modified Block
+22 ;
ASKPAT2() ; Select the Patient to filter by
+1 ; Input: None
+2 ; Returns: IEN - Select Patient IEN file #2
+3 ; 0 - User entered '^' or timed out or no patient selected
+4 NEW DIC,DIROUT,DIRUT,DTOUT,DUOUT
+5 SET DIC="^DPT("
SET DIC(0)="AEINMQ"
+6 SET DIC("A")="Select Patient: "
+7 DO ^DIC
+8 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+9 if Y<1
QUIT 0
+10 if Y=""
QUIT 0
+11 QUIT $PIECE(Y,U,1)
+12 ;
+13 ; prca*4.5*349 - Subroutine added
ASKPAT3() ; Ask whether to display comment details for single patient search
+1 ; Input: None
+2 ; Returns: Y = Yes, display comment details
+3 ; N = No, do not display comment details
+4 ; -1 = User entered '^' or timed out
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
+6 SET DIR(0)="YA"
+7 SET DIR("A")="Display Comment Detail? (Y/N)// "
+8 DO ^DIR
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT -1
+10 QUIT Y
+11 ;
ASKSORT() ; EP from RCDPEFA1 - Select the sort criteria
+1 ; Input: None
+2 ; Returns: C - Sort by Claim
+3 ; N - Sort by Patient Name
+4 ; 0 - User entered '^' or timed out
+5 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX
+6 SET DIR(0)="SA^C:CLAIM;N:PATIENT NAME;"
+7 SET DIR("A")="Sort by (C)LAIM # or PATIENT (N)AME?: "
+8 SET DIR("?",1)="Enter 'C' to sort by Claim Number or 'N' to sort"
+9 SET DIR("?")="by Patient Name."
+10 SET DIR("B")="CLAIM"
+11 DO ^DIR
+12 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+13 QUIT Y
+14 ;
SORTORD(SORT) ; EP from RCDPEFA1 - Select the sort order
+1 ; Input: SORT - 'C' - Sort by Claim Number
+2 ; 'N' - Sort by Patient Name
+3 ; Returns: F - First to Last
+4 ; L - Last to First
+5 ; 0 - User entered '^' or timed out
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,XX,YY
+7 SET XX=" (F)IRST TO LAST or (L)AST TO FIRST?: "
+8 SET YY=$SELECT(SORT="C":"CLAIM",1:"PATIENT NAME")
+9 SET DIR("A")="Sort "_YY_XX
+10 SET DIR(0)="SA^F:FIRST TO LAST;L:LAST TO FIRST"
+11 SET DIR("B")="FIRST TO LAST"
+12 DO ^DIR
+13 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+14 QUIT Y
+15 ;
DTRNG() ; EP from RCDPEFA1 - Get the date range for the report
+1 ; Input: None
+2 ; Returns: A1|A2|A3 - Where:
+3 ; A1 - 0 - User up-arrowed or timed out, 1 otherwise
+4 ; A2 - Auto-Post Start Date
+5 ; A3 - Auto-Post End Date
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCEND,RCSTART,RNGFLG,X,Y
+7 DO DATES(.RCSTART,.RCEND)
+8 if RCSTART=-1
QUIT 0
+9 if RCSTART
QUIT "1|"_RCSTART_"|"_RCEND
+10 if 'RCSTART
QUIT "0||"
+11 QUIT 0
+12 ;
DATES(BDATE,EDATE) ; Get a date range.
+1 ; Input: None
+2 ; Output: BDATE - Internal Auto-Post Start Date
+3 ; EDATE - Internal Auto-Post End Date
D1 ; looping tag
+1 SET (BDATE,EDATE)=0
+2 SET DIR("?")="Enter the earliest Auto-Posting date to include on the report."
+3 SET DIR(0)="DAO^:"_DT_":APE"
+4 SET DIR("A")="Start Date: "
+5 DO ^DIR
+6 KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET BDATE=-1
QUIT
+8 SET BDATE=Y
+9 SET DIR("?")="Enter the latest Auto-Posting date to include on the report."
+10 SET DIR("B")=Y(0)
+11 SET DIR(0)="DAO^"_BDATE_":"_DT_":APE"
+12 SET DIR("A")="End Date: "
+13 DO ^DIR
+14 KILL DIR
+15 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET BDATE=-1
QUIT
+16 SET EDATE=Y
+17 QUIT
+18 ;
DISPTY() ; EP from RCDPEFA1 - Get display/output type
+1 ; Input: None
+2 ; Returns: 1 - Output to Excel
+3 ; 0 - Output to paper
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Export the report to Microsoft Excel"
+7 SET DIR("B")="NO"
+8 DO ^DIR
+9 IF $GET(DUOUT)
QUIT -1
+10 QUIT Y
+11 ;
+12 ; PRCA*4.5*349 - Subroutine added
DETSUM() ; EP from RCDPEFA1 - Get detail/summary type
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,Y
+2 SET DIR("A")="Display (S)UMMARY or (D)ETAIL Format?: "
+3 SET DIR(0)="SA^S:SUMMARY;D:DETAIL"
+4 SET DIR("B")="DETAIL"
+5 DO ^DIR
+6 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+7 QUIT Y
+8 ;
DEVICE(IO) ; Select output device
+1 ; Input: None
+2 ; Output: IO - Array of selected output info
+3 ; Returns: 0 - No device selected, 1 Otherwise
+4 NEW POP,%ZIS
+5 SET %ZIS="QM"
+6 DO ^%ZIS
+7 if POP
QUIT 0
+8 QUIT 1
+9 ;
LMAN(DATA,INPUT,RCCMT,XX) ;EP from RCDPEFA1
+1 ; Format and save List Manager line
+2 ; Input: DATA - ERA line adjustment total
+3 ; INPUT - Input parameters in delimited list
+4 ; RCCMT - Array of free text comments for this decrease
+5 ; XX - List Counter for ^TMP("RCDPE_ADP",$J)
+6 ;
+7 NEW CNT,Y
+8 ; Patient Name/SSN last 4
SET Y=$PIECE(DATA,U,3)
+9 ; COPAY Amount
SET $EXTRACT(Y,33)=$JUSTIFY($PIECE(DATA,U,4),6,2)
+10 ; Auto-Decrease Amount
SET $EXTRACT(Y,41)=$JUSTIFY($PIECE(DATA,U,5),6,2)
+11 ; Copay Claim #
SET $EXTRACT(Y,49)=$EXTRACT($PIECE(DATA,U,6),1,10)
+12 ; 3rd Party Claim #
SET $EXTRACT(Y,61)=$EXTRACT($PIECE(DATA,U,7),1,10)
+13 ; Auto-Decrease Date
SET $EXTRACT(Y,73)=$PIECE(DATA,U,8)
+14 SET ^TMP("RCDPE_ADP",$JOB,XX)=Y
SET XX=XX+1
+15 ; Show comment detail?
IF $PIECE($PIECE(INPUTS,U,7),"|",3)=1
Begin DoDot:1
+16 ;
SET CNT=""
FOR
SET CNT=$ORDER(RCCMT(CNT))
if CNT=""
QUIT
Begin DoDot:2
+17 SET Y=$SELECT(CNT=1:" Comment: ",1:" ")
+18 SET Y=Y_RCCMT(CNT)
+19 SET ^TMP("RCDPE_ADP",$JOB,XX)=Y
SET XX=XX+1
End DoDot:2
End DoDot:1
+20 QUIT
+21 ;
TOTALD(LMAN,HDRINFO,PAGE,STOP,DAY,DTOTAL,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 ; DTOTAL - Array of totals by day
+6 ; LCNT - Current line count (only passedif LMAN=1)
+7 ; Output: PAGE - Updated Page Number (if a new header is displayed)
+8 ; STOP - 1 if user indiacted to stop
+9 ; LCNT - Updated line count (only passedif LMAN=1)
+10 NEW DAMT,DCNT,LN1,LN2,LN3,DCOP
+11 SET DCNT=$PIECE(DTOTAL(DAY),U,1)
+12 SET DAMT=$PIECE(DTOTAL(DAY),U,2)
+13 ; PRCA*4.5*349
SET DCOP=$PIECE(DTOTAL(DAY),U,3)
+14 SET LN1="**Totals for Date: "_$$FMTE^XLFDT(DAY,"2Z")
+15 SET $EXTRACT(LN1,35)=" # of Decrease Adjustments: "_DCNT
+16 SET LN2=""
SET $EXTRACT(LN2,28)="Total Amount of Decrease Adjustments: $"_$JUSTIFY(DAMT,3,2)
+17 ; PRCA*4.5*349
SET LN3=""
SET $EXTRACT(LN3,22)="% of Dollars Auto-Decreased of Total Copay: "_$$PCENT^RCDPEFA1(DAMT,DCOP)_"%"
+18 ;
+19 IF LMAN
Begin DoDot:1
+20 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=""
SET LCNT=LCNT+1
+21 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=LN1
SET LCNT=LCNT+1
+22 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=LN2
SET LCNT=LCNT+1
+23 ; PRCA*4.5*349
SET ^TMP("RCDPE_ADP",$JOB,LCNT)=LN3
SET LCNT=LCNT+1
+24 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=""
SET LCNT=LCNT+1
End DoDot:1
QUIT
+25 ;
+26 IF $Y>(IOSL-7)
Begin DoDot:1
+27 DO ASK^RCDPEADP(.STOP,0)
+28 if STOP
QUIT
+29 DO HDR^RCDPEFA1(EXCEL,.HDRINFO,.PAGE)
End DoDot:1
+30 if STOP
QUIT
+31 WRITE !!,LN1
+32 WRITE !,LN2
+33 ; PRCA*4.5*349
WRITE !,LN3
+34 QUIT
+35 ;
TOTALG(LMAN,HDRINFO,PAGE,GTOTAL,STOP,LCNT) ; Overall report total
+1 ; Input: LMAN - 1 if output to Listman, 0 otherwise
+2 ; HDRINFO - Array of header info
+3 ; PAGE - Current Page Number
+4 ; GTOTAL - Grand Totals for report
+5 ; LCNT - Current line count (only passedif LMAN=1)
+6 ; Output: PAGE - Updated Page Number (if new header is displayed)
+7 ; LCNT - Updated line count (only passedif LMAN=1)
+8 NEW LN1,LN2,LN3,GAMT,GCOP
+9 ; PRCA*4.5*349
SET GAMT=+$PIECE(GTOTAL,U,2)
SET GCOP=+$PIECE(GTOTAL,U,3)
+10 SET LN1="**** Totals for Date Range: # of Decrease Adjustments: "_+$PIECE(GTOTAL,U,1)
+11 SET LN2=""
SET $EXTRACT(LN2,28)="Total Amount of Decrease Adjustments: $"_$JUSTIFY((+$PIECE(GTOTAL,U,2)),3,2)
+12 ; PRCA*4.5*349
SET LN3=""
SET $EXTRACT(LN3,22)="% of Dollars Auto-Decreased of Total Copay: "_$$PCENT^RCDPEFA1(GAMT,GCOP)_"%"
+13 ;
+14 IF LMAN
Begin DoDot:1
+15 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=""
SET LCNT=LCNT+1
+16 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=LN1
SET LCNT=LCNT+1
+17 SET ^TMP("RCDPE_ADP",$JOB,LCNT)=LN2
SET LCNT=LCNT+1
+18 ; PRCA*4.5*349
SET ^TMP("RCDPE_ADP",$JOB,LCNT)=LN3
SET LCNT=LCNT+1
End DoDot:1
QUIT
+19 ;
+20 IF $Y>(IOSL-6)
Begin DoDot:1
+21 DO ASK^RCDPEADP(.STOP,0)
+22 if STOP
QUIT
+23 DO HDR^RCDPEFA1(EXCEL,.HDRINFO,.PAGE)
End DoDot:1
+24 if STOP
QUIT
+25 WRITE !!,"**** Totals for Date Range: # of Decrease Adjustments: "_+$PIECE(GTOTAL,U,1)
+26 SET Y=""
SET $EXTRACT(Y,28)="Total Amount of Decrease Adjustments: $"_$JUSTIFY((+$PIECE(GTOTAL,U,2)),3,2)
+27 ; PRCA*4.5*349
WRITE !,Y
+28 ; PRCA*4.5*349
SET Y=""
SET $EXTRACT(Y,22)="% of Dollars Auto-Decreased of Total Copay: "_$$PCENT^RCDPEFA1(GAMT,GCOP)_"%"
+29 WRITE !,Y,!
+30 QUIT
