RCDPESP8 ;AITC/CJE - ePayment Lockbox Site Parameters History
;;4.5;Accounts Receivable;**332,424**;Mar 20, 1995;Build 11
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; entry point for EDI Lockbox Parameters History Report [RCDPE PARAMETER HISTORY REPORT]
N BDATE,EDATE,RCHDR,IEN2,POP,RCDATE,RCDISPTY,RCEND,RCLN,RCNEW,RCOLD,RCPGNUM,RCSTOP,RCTMPND,RCUSRVALMHDR
K ^TMP($J,"RCDPESP8")
Q:$$PROMPTS(.BDATE,.EDATE,.RCLM)=-1 ; Prompt for report parameters
;
S RCPGNUM=0,RCSTOP=0
I RCLM D G EXIT
. S RCTMPND="RCDPESP8" K ^TMP($J,RCTMPND) ; clean any residue
. D COMPILE
. D LMRPT^RCDPEARL(.VALMHDR,$NA(^TMP($J,RCTMPND))) ; generate ListMan display
. I $D(RCTMPND) K ^TMP($J,RCTMPND)
;
W !
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
.N ZTDESC,ZTRTN,ZTSAVE,ZTSK
.S ZTRTN="COMPILE^RCDPESP8",ZTDESC="EDI LOCKBOX AUTO PARAMETER HISTORY REPORT"
.S ZTSAVE("*")=""
.D ^%ZTLOAD
.W !!,$S($D(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
.K IO("Q") D HOME^%ZIS
;
U IO
D COMPILE
I 'RCSTOP D ASK^RCDPEARL(.RCSTOP)
;
Q
COMPILE ; Get data for user selected date range
N IEN2,LINE,LMHDR,RCDET,RCPARAM,RCSEQ,RCUSR,SPACE,SPLIT
S SPACE=$J("",40)
S RCSEQ=0
S RCDATE=BDATE,RCEND=EDATE_"."_24
F S RCDATE=$O(^RCY(344.61,1,2,"ADU",RCDATE)) Q:(RCDATE>RCEND)!(RCDATE="") D ;
. S RCUSR=""
. F S RCUSR=$O(^RCY(344.61,1,2,"ADU",RCDATE,RCUSR)) Q:RCUSR="" D ;
. . S RCSEQ=RCSEQ+1
. . S ^TMP($J,"RCDPESP8",RCSEQ)=$E($$FMTE^XLFDT(RCDATE,"2Z")_SPACE,1,19)_RCUSR
. . S IEN2=""
. . F S IEN2=$O(^RCY(344.61,1,2,"ADU",RCDATE,RCUSR,IEN2)) Q:IEN2="" D ;
. . . S RCPARAM=$$GET1^DIQ(344.611,IEN2_",1,",1,"E")
. . . S RCDET=$$GET1^DIQ(344.611,IEN2_",1,",2,"E")
. . . S RCOLD=$$GET1^DIQ(344.611,IEN2_",1,",3,"E")
. . . S RCNEW=$$GET1^DIQ(344.611,IEN2_",1,",4,"E")
. . . S SPLIT=0
. . . S RCSEQ=RCSEQ+1
. . . S LINE=" "_RCPARAM
. . . I $L(LINE_" ("_RCDET_")")>62 S SPLIT=1
. . . I 'SPLIT D ;
. . . . I RCDET'="" S LINE=LINE_" ("_RCDET_")"
. . . . S LINE=LINE_$J("",62-$L(LINE))_" "_$J(RCOLD,8)_" "_$J(RCNEW,8)
. . . S ^TMP($J,"RCDPESP8",RCSEQ)=LINE
. . . I SPLIT D ;
. . . . S RCSEQ=RCSEQ+1
. . . . S LINE=" "_$E(RCDET,1,58)
. . . . S LINE=LINE_$J("",62-$L(LINE))_" "_$J(RCOLD,8)_" "_$J(RCNEW,8)
. . . . S ^TMP($J,"RCDPESP8",RCSEQ)=LINE
I 'RCLM D ;
. D OUTPUT
E D ;
. D HEAD
. S LMHDR("TITLE")="Auto Parameter History Report"
. S LMHDR(1)=RCHDR(2)
. S LMHDR(2)=RCHDR(3)
. S LMHDR(3)=""
. S LMHDR(4)=""
. S LMHDR(5)=""
. S LMHDR(6)=RCHDR(5)
. S LMHDR(7)=RCHDR(6)
. D LMRPT^RCDPEARL(.LMHDR,$NA(^TMP($J,"RCDPESP8"))) ; Generate ListMan display
;
EXIT ; Exit point to clean up ^TMP
K ^TMP($J,"RCDPESP8")
Q
;
OUTPUT ; Output printed report to screen or printer
S RCPGNUM=0
D HEAD
S RCSEQ=0
F S RCSEQ=$O(^TMP($J,"RCDPESP8",RCSEQ)) Q:'RCSEQ D I RCSTOP Q
. I $Y>(IOSL-3)!(RCPGNUM=0) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) I RCSTOP Q
. W !,^TMP($J,"RCDPESP8",RCSEQ)
Q
HEAD ; Print header
N LINE
S LINE="Auto Parameter History Report"
S LINE=$J("",(80-$L(LINE)\2))_LINE
S RCHDR("H")=LINE_$J("",71-$L(LINE))
S LINE="RUN DATE: "_$$FMTE^XLFDT($$NOW^XLFDT,"2Z")
S RCHDR(2)=$J("",(80-$L(LINE)\2))_LINE
S LINE="DATE RANGE: "_$$FMTE^XLFDT(BDATE,"2DZ")_" - "_$$FMTE^XLFDT(EDATE,"2DZ")
S RCHDR(3)=$J("",(80-$L(LINE)\2))_LINE
S RCHDR(4)=""
S LINE="Date/Time Edited User"_$J("",48)_"Values"
S RCHDR(5)=LINE
S LINE=" Parameter"_$J("",57)_"Old New"
S RCHDR(6)=LINE
S RCHDR(7)=$TR($J("",80)," ","=")
S RCHDR("XECUTE")="S RCPGNUM=RCPGNUM+1,RCHDR(1)=RCHDR(""H"")_""Page: ""_RCPGNUM"
S RCDISPTY=$S(RCLM:1,1:0)
S RCHDR(0)=7
;
S VALMHDR(1)=RCHDR("H")
S VALMHDR(2)=RCHDR(3)
S VALMHDR(3)=""
S VALMHDR(4)=RCHDR(5)
S VALMHDR(5)=RCHDR(6)
Q
;
PROMPTS(BDATE,EDATE,RCLM,RCXL) ; Propmt for report Parameters
; Input: None
; Output: BDATE - Start date for report in FileMan internal format
; EDATE - End date for report in Fileman internal format
; RCLM - Boolean flag - display in ListMan
; Returns: -1 Quit without running report
; 1 Continue
;
N DIR,RETURN,Y
S RETURN=1
S DIR("?")="ENTER THE DATE OF THE EARIEST PARAMETER CHANGE TO INCLUDE"
S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Start Date: ",DIR("B")="T" D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S RETURN=-1 G PQ
S BDATE=Y
;
K DIR
S DIR("?")="ENTER THE DATE OF THE LATEST PARAMETER CHANGE TO INCLUDE"
S DIR("B")="T"
S DIR(0)="DAO^"_BDATE_":"_DT_":APE",DIR("A")="End Date: " D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT)!(Y="") S RETURN=-1 G PQ
S EDATE=Y
;
S RCLM=$$ASKLM^RCDPEARL() I RCLM=-1 S RETURN=-1
PQ ; Common exit point for PROMPTS
Q RETURN
;
; PRCA*4.5*424 Subroutine added
ZEROPOST ; Auto post historic zero payment ERAs - (EP) Tasked from RCDPESP6
N AMT,ERAIEN,REC0
; Iterate through ERA file and find zero payment ERAs
S ERAIEN=0
F S ERAIEN=$O(^RCY(344.4,ERAIEN)) Q:'ERAIEN D ;
. S REC0=$G(^RCY(344.4,ERAIEN,0))
. S AMT=+$P(REC0,"^",5)
. I AMT'=0 Q ;
. ; Ignore ERA if it was posted or marked as MATCH ZERO PAY
. S STATUS=$P(REC0,"^",14),MATCH=$P(REC0,"^",9)
. I STATUS!MATCH Q
. ; Check if ERA if eligible for auto-posting. Payer not excluded, all detail lines have 0 payment
. I $$AUTOCHK2^RCDPEAP1(ERAIEN,1) D ;
. . ; Mark this ERA as posted matched zero pay etc.
. . D POST0^RCDPEAP2(ERAIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESP8 5483 printed Nov 22, 2024@16:55:30 Page 2
RCDPESP8 ;AITC/CJE - ePayment Lockbox Site Parameters History
+1 ;;4.5;Accounts Receivable;**332,424**;Mar 20, 1995;Build 11
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; entry point for EDI Lockbox Parameters History Report [RCDPE PARAMETER HISTORY REPORT]
+1 NEW BDATE,EDATE,RCHDR,IEN2,POP,RCDATE,RCDISPTY,RCEND,RCLN,RCNEW,RCOLD,RCPGNUM,RCSTOP,RCTMPND,RCUSRVALMHDR
+2 KILL ^TMP($JOB,"RCDPESP8")
+3 ; Prompt for report parameters
if $$PROMPTS(.BDATE,.EDATE,.RCLM)=-1
QUIT
+4 ;
+5 SET RCPGNUM=0
SET RCSTOP=0
+6 IF RCLM
Begin DoDot:1
+7 ; clean any residue
SET RCTMPND="RCDPESP8"
KILL ^TMP($JOB,RCTMPND)
+8 DO COMPILE
+9 ; generate ListMan display
DO LMRPT^RCDPEARL(.VALMHDR,$NAME(^TMP($JOB,RCTMPND)))
+10 IF $DATA(RCTMPND)
KILL ^TMP($JOB,RCTMPND)
End DoDot:1
GOTO EXIT
+11 ;
+12 WRITE !
+13 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+14 IF $DATA(IO("Q"))
Begin DoDot:1
+15 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+16 SET ZTRTN="COMPILE^RCDPESP8"
SET ZTDESC="EDI LOCKBOX AUTO PARAMETER HISTORY REPORT"
+17 SET ZTSAVE("*")=""
+18 DO ^%ZTLOAD
+19 WRITE !!,$SELECT($DATA(ZTSK):"Your task number"_ZTSK_" has been queued.",1:"Unable to queue this job.")
+20 KILL IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+21 ;
+22 USE IO
+23 DO COMPILE
+24 IF 'RCSTOP
DO ASK^RCDPEARL(.RCSTOP)
+25 ;
+26 QUIT
COMPILE ; Get data for user selected date range
+1 NEW IEN2,LINE,LMHDR,RCDET,RCPARAM,RCSEQ,RCUSR,SPACE,SPLIT
+2 SET SPACE=$JUSTIFY("",40)
+3 SET RCSEQ=0
+4 SET RCDATE=BDATE
SET RCEND=EDATE_"."_24
+5 ;
FOR
SET RCDATE=$ORDER(^RCY(344.61,1,2,"ADU",RCDATE))
if (RCDATE>RCEND)!(RCDATE="")
QUIT
Begin DoDot:1
+6 SET RCUSR=""
+7 ;
FOR
SET RCUSR=$ORDER(^RCY(344.61,1,2,"ADU",RCDATE,RCUSR))
if RCUSR=""
QUIT
Begin DoDot:2
+8 SET RCSEQ=RCSEQ+1
+9 SET ^TMP($JOB,"RCDPESP8",RCSEQ)=$EXTRACT($$FMTE^XLFDT(RCDATE,"2Z")_SPACE,1,19)_RCUSR
+10 SET IEN2=""
+11 ;
FOR
SET IEN2=$ORDER(^RCY(344.61,1,2,"ADU",RCDATE,RCUSR,IEN2))
if IEN2=""
QUIT
Begin DoDot:3
+12 SET RCPARAM=$$GET1^DIQ(344.611,IEN2_",1,",1,"E")
+13 SET RCDET=$$GET1^DIQ(344.611,IEN2_",1,",2,"E")
+14 SET RCOLD=$$GET1^DIQ(344.611,IEN2_",1,",3,"E")
+15 SET RCNEW=$$GET1^DIQ(344.611,IEN2_",1,",4,"E")
+16 SET SPLIT=0
+17 SET RCSEQ=RCSEQ+1
+18 SET LINE=" "_RCPARAM
+19 IF $LENGTH(LINE_" ("_RCDET_")")>62
SET SPLIT=1
+20 ;
IF 'SPLIT
Begin DoDot:4
+21 IF RCDET'=""
SET LINE=LINE_" ("_RCDET_")"
+22 SET LINE=LINE_$JUSTIFY("",62-$LENGTH(LINE))_" "_$JUSTIFY(RCOLD,8)_" "_$JUSTIFY(RCNEW,8)
End DoDot:4
+23 SET ^TMP($JOB,"RCDPESP8",RCSEQ)=LINE
+24 ;
IF SPLIT
Begin DoDot:4
+25 SET RCSEQ=RCSEQ+1
+26 SET LINE=" "_$EXTRACT(RCDET,1,58)
+27 SET LINE=LINE_$JUSTIFY("",62-$LENGTH(LINE))_" "_$JUSTIFY(RCOLD,8)_" "_$JUSTIFY(RCNEW,8)
+28 SET ^TMP($JOB,"RCDPESP8",RCSEQ)=LINE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+29 ;
IF 'RCLM
Begin DoDot:1
+30 DO OUTPUT
End DoDot:1
+31 ;
IF '$TEST
Begin DoDot:1
+32 DO HEAD
+33 SET LMHDR("TITLE")="Auto Parameter History Report"
+34 SET LMHDR(1)=RCHDR(2)
+35 SET LMHDR(2)=RCHDR(3)
+36 SET LMHDR(3)=""
+37 SET LMHDR(4)=""
+38 SET LMHDR(5)=""
+39 SET LMHDR(6)=RCHDR(5)
+40 SET LMHDR(7)=RCHDR(6)
+41 ; Generate ListMan display
DO LMRPT^RCDPEARL(.LMHDR,$NAME(^TMP($JOB,"RCDPESP8")))
End DoDot:1
+42 ;
EXIT ; Exit point to clean up ^TMP
+1 KILL ^TMP($JOB,"RCDPESP8")
+2 QUIT
+3 ;
OUTPUT ; Output printed report to screen or printer
+1 SET RCPGNUM=0
+2 DO HEAD
+3 SET RCSEQ=0
+4 FOR
SET RCSEQ=$ORDER(^TMP($JOB,"RCDPESP8",RCSEQ))
if 'RCSEQ
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-3)!(RCPGNUM=0)
DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)
IF RCSTOP
QUIT
+6 WRITE !,^TMP($JOB,"RCDPESP8",RCSEQ)
End DoDot:1
IF RCSTOP
QUIT
+7 QUIT
HEAD ; Print header
+1 NEW LINE
+2 SET LINE="Auto Parameter History Report"
+3 SET LINE=$JUSTIFY("",(80-$LENGTH(LINE)\2))_LINE
+4 SET RCHDR("H")=LINE_$JUSTIFY("",71-$LENGTH(LINE))
+5 SET LINE="RUN DATE: "_$$FMTE^XLFDT($$NOW^XLFDT,"2Z")
+6 SET RCHDR(2)=$JUSTIFY("",(80-$LENGTH(LINE)\2))_LINE
+7 SET LINE="DATE RANGE: "_$$FMTE^XLFDT(BDATE,"2DZ")_" - "_$$FMTE^XLFDT(EDATE,"2DZ")
+8 SET RCHDR(3)=$JUSTIFY("",(80-$LENGTH(LINE)\2))_LINE
+9 SET RCHDR(4)=""
+10 SET LINE="Date/Time Edited User"_$JUSTIFY("",48)_"Values"
+11 SET RCHDR(5)=LINE
+12 SET LINE=" Parameter"_$JUSTIFY("",57)_"Old New"
+13 SET RCHDR(6)=LINE
+14 SET RCHDR(7)=$TRANSLATE($JUSTIFY("",80)," ","=")
+15 SET RCHDR("XECUTE")="S RCPGNUM=RCPGNUM+1,RCHDR(1)=RCHDR(""H"")_""Page: ""_RCPGNUM"
+16 SET RCDISPTY=$SELECT(RCLM:1,1:0)
+17 SET RCHDR(0)=7
+18 ;
+19 SET VALMHDR(1)=RCHDR("H")
+20 SET VALMHDR(2)=RCHDR(3)
+21 SET VALMHDR(3)=""
+22 SET VALMHDR(4)=RCHDR(5)
+23 SET VALMHDR(5)=RCHDR(6)
+24 QUIT
+25 ;
PROMPTS(BDATE,EDATE,RCLM,RCXL) ; Propmt for report Parameters
+1 ; Input: None
+2 ; Output: BDATE - Start date for report in FileMan internal format
+3 ; EDATE - End date for report in Fileman internal format
+4 ; RCLM - Boolean flag - display in ListMan
+5 ; Returns: -1 Quit without running report
+6 ; 1 Continue
+7 ;
+8 NEW DIR,RETURN,Y
+9 SET RETURN=1
+10 SET DIR("?")="ENTER THE DATE OF THE EARIEST PARAMETER CHANGE TO INCLUDE"
+11 SET DIR(0)="DAO^:"_DT_":APE"
SET DIR("A")="Start Date: "
SET DIR("B")="T"
DO ^DIR
KILL DIR
+12 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET RETURN=-1
GOTO PQ
+13 SET BDATE=Y
+14 ;
+15 KILL DIR
+16 SET DIR("?")="ENTER THE DATE OF THE LATEST PARAMETER CHANGE TO INCLUDE"
+17 SET DIR("B")="T"
+18 SET DIR(0)="DAO^"_BDATE_":"_DT_":APE"
SET DIR("A")="End Date: "
DO ^DIR
KILL DIR
+19 IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")
SET RETURN=-1
GOTO PQ
+20 SET EDATE=Y
+21 ;
+22 SET RCLM=$$ASKLM^RCDPEARL()
IF RCLM=-1
SET RETURN=-1
PQ ; Common exit point for PROMPTS
+1 QUIT RETURN
+2 ;
+3 ; PRCA*4.5*424 Subroutine added
ZEROPOST ; Auto post historic zero payment ERAs - (EP) Tasked from RCDPESP6
+1 NEW AMT,ERAIEN,REC0
+2 ; Iterate through ERA file and find zero payment ERAs
+3 SET ERAIEN=0
+4 ;
FOR
SET ERAIEN=$ORDER(^RCY(344.4,ERAIEN))
if 'ERAIEN
QUIT
Begin DoDot:1
+5 SET REC0=$GET(^RCY(344.4,ERAIEN,0))
+6 SET AMT=+$PIECE(REC0,"^",5)
+7 ;
IF AMT'=0
QUIT
+8 ; Ignore ERA if it was posted or marked as MATCH ZERO PAY
+9 SET STATUS=$PIECE(REC0,"^",14)
SET MATCH=$PIECE(REC0,"^",9)
+10 IF STATUS!MATCH
QUIT
+11 ; Check if ERA if eligible for auto-posting. Payer not excluded, all detail lines have 0 payment
+12 ;
IF $$AUTOCHK2^RCDPEAP1(ERAIEN,1)
Begin DoDot:2
+13 ; Mark this ERA as posted matched zero pay etc.
+14 DO POST0^RCDPEAP2(ERAIEN)
End DoDot:2
End DoDot:1
+15 QUIT
