- 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 Feb 18, 2025@23:11:41 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
