RCDPESP1 ;BIRM/SAB - ePayment Lockbox Site Parameter Reports ;29 Jan 2019 18:00:14
;;4.5;Accounts Receivable;**298,304,318,321,326,332,345,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
RPT ; EDI Lockbox Parameters Report [RCDPE SITE PARAMETER REPORT]
; report data from:
; AR SITE PARAMETER file (#342)
; RCDPE PARAMETER file (#344.61)
; RCDPE AUTO-PAY EXCLUSION file (#344.6)
;
; LOCAL VARIABLES:
; RTYPE - Type of Report to run (Medical, Pharmacy, or Both)
;
; PRCA*4.5*349 - Add categories prompt
N %ZIS,POP,RCCATS,RCHDR,RCLSTMGR,RCTEMP,RCTMPND,RCTYPE
S RCCATS=$$CATS^RCDPESPC
I RCCATS="" D RPTQ Q
W !,$$HDRLN,!
;
S RCTYPE=$$RTYPE^RCDPESP2
I RCTYPE=-1 D RPTQ Q
; PRCA*4.5*349 - Start modified code block
S RCLSTMGR=$$ASKLM^RCDPEARL ; Ask to Display in Listman Template
Q:RCLSTMGR<0 ; '^' or timeout
I RCLSTMGR D D RPTQ Q ;
. S RCTMPND="RC SP REPORT"
. K ^TMP($J,RCTMPND)
. I RCCATS="AL" D ;
. . D SPRPT
. E D ;
. . D SPRPT^RCDPESPC
. D LMHDR^RCDPESPC(.RCHDR,RCTYPE,RCCATS)
. S RCTEMP="RCDPE PARAMETERS REPORT"
. D LMRPT^RCDPEARL(.RCHDR,$NA(^TMP($J,RCTMPND)),RCTEMP) ; Generate ListMan display
. K ^TMP($J,RCTMPND)
; PRCA*4.5*349 - End modified code block
W !! ; skip lines before device prompt
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) D Q
. N ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
. ; PRCA*4.5*349 - Task subroutine based on whether "All" or some cats were chosen
. S ZTRTN=$S(RCCATS="AL":"SPRPT",1:"SPRPT2")_"^RCDPESP1",ZTDESC=$$HDRLN,ZTSAVE("RC*")=""
. D ^%ZTLOAD
. W !!,$S($G(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this task.")
. K IO("Q") D HOME^%ZIS
;
; PRCA*4.5*349 - Call correct subroutine depending on whether "All" cats are shown or not
I RCCATS="AL" D SPRPT Q
D SPRPT^RCDPESPC
;
RPTQ ;
Q
;
SPRPT ; site parameter report entry point
; Input: RCTYPE - Type of report (Medical/Rx/TRICARE/All)
; RCCATS - List of categories selected for report
; RCNTR - counter
; RCFLD - DD field number
; RCHDR - header information
; RCPARM - parameters
; RCSTOP - exit flag
N FLDS,J,RCACTV,RCCARCD,RCCIEN,RCCODE,RCDATA,RCDESC,RCFLD,RCGLB,RCHDR,RCI,RCITEM
N RCNTR,RCPARM,RCSTAT,RCSTOP,RCSTRING,V,X,XX,Y,YY
;
S X="RC"
F S X=$O(^TMP($J,X)) Q:'($E(X,1,2)="RC") K ^TMP($J,X) ; clear out old data
;
; RCGLB - ^TMP global storage locations
; ^TMP($J,"RC342") - AR SITE PARAMETER file (#342)
; ^TMP($J,"RC344.6") - RCDPE AUTO-PAY EXCLUSION file (#344.6)
; ^TMP($J,"RC344.61") - RCDPE PARAMETER file (#344.61)
F J=342,344.6,344.61 D ;
. S RCGLB(J)=$NA(^TMP($J,"RC"_J))
. K @RCGLB(J)
;
S RCHDR("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"10S")
S RCHDR("PGNMBR")=0 ; page number
;
; AR SITE PARAMETER file (#342)
D GETS^DIQ(342,"1,",".01;.14;.15;7.02;7.03;7.04;7.05;7.06;7.07;7.08;7.09","E",RCGLB(342)) ; PRCA*4.5*345
; add site to header data
S RCHDR("SITE")="Site: "_@RCGLB(342)@(342,"1,",.01,"E")
;
; PRCA*4.5*345 add field .14 and .15 for first party auto-decrease
D AD2RPT("### EDI Lockbox Site & First Party Parameters ###")
F RCFLD=7.02,7.03,7.04,.14,.15,7.05,7.06,7.07,7.08,7.09 D ; EFT and ERA days unmatched - PRCA*4.5*321
. I RCFLD=7.05 D AD2RPT(" "),AD2RPT("### Auto-Audit Site Parameters ###")
. S RCITEM=$S(RCFLD=.14!(RCFLD=.15)!(RCFLD>7.04):"TITLE",1:"LABEL") ; PRCA*4.5*345
. I RCTYPE="P",(RCFLD=7.05)!(RCFLD=7.07)!(RCFLD=7.09) Q ; PRCA*4.5*349 Exclude TRICARE
. I RCTYPE="M",(RCFLD=7.06)!(RCFLD=7.08)!(RCFLD=7.09) Q ; PRCA*4.5*349 Exclude TRICARE
. I RCTYPE="T",RCFLD>7.04,RCFLD<7.09 Q ; PRCA*4.5*349 Line Added TRICARE
. S Y=$$GET1^DID(342,RCFLD,,RCITEM)_": "_@RCGLB(342)@(342,"1,",RCFLD,"E")
. I RCFLD=7.05 D AD2RPT(" ")
. I (RCFLD=7.06),(RCTYPE="P") D AD2RPT(" ")
. I (RCFLD=7.09),(RCTYPE="T") D AD2RPT(" ")
. D AD2RPT(Y)
;
D AD2RPT(" ")
;
; Display Parameters
; RCDPE PARAMETER file (#344.61)
S Y=".02;.03;.04;.05;.06;.07;.1;.11;.12;.13;1.01;1.02;1.03;1.04"
S Y=Y_";1.05;1.06;1.07;1.08;1.09;1.1" ; PRCA*4.5*349 - Add TRICARE
D GETS^DIQ(344.61,"1,",Y,"E",RCGLB(344.61))
;
S Y=$$GET1^DID(344.61,.1,,"LABEL")_": "_@RCGLB(344.61)@(344.61,"1,",.1,"E") ; PRCA*4.5*321
D AD2RPT("### Workload Notification Day Parameter ###")
D AD2RPT(Y),AD2RPT(" ") ; PRCA*4.5*321
;
; get auto-post and auto-decrease settings, save zero node
S X=$G(^RCY(344.61,1,0))
S XX=$G(^RCY(344.61,1,1)) ; PRCA*4.5*349 - Added line
S RCPARM("AUTO-POST")=$P(X,U,2)
S RCPARM("AUTO-DECREASE")=$P(X,U,3)
S RCPARM(344.61,0)=X
S RCPARM(344.61,1)=XX ; PRCA*4.5*349 - Added line
S RCPARM("RX AUTO-POST")=$P(XX,U,1)
S RCPARM("RX AUTO-DECREASE")=$P(XX,U,2) ; PRCA*4.5*349 - Added line
S RCPARM("TRI AUTO-POST")=$P(XX,U,5) ; PRCA*4.5*349 - Added line
S RCPARM("TRI AUTO-DECREASE")=$P(XX,U,6) ; PRCA*4.5*349 - Added line
;
; PRCA*4.5*349 - Start modified block - Move code into subroutines for easier maintenance
I (RCTYPE="M")!(RCTYPE="A") D MPARAMS^RCDPESPC(.RCPARM) ; Display Medical Claim parameters
;
I (RCTYPE="P")!(RCTYPE="A") D RXPARAMS^RCDPESPC(.RCPARM) ; Display Rx parameters
;
I (RCTYPE="T")!(RCTYPE="A") D TPARAMS^RCDPESPC(.RCPARM) ; Display Rx parameters
; PRCA*4.5*349 - End modified block
;
; RCDPE PARAMETER file (#344.61)
; ^DD(344.61,.06,0) > "MEDICAL EFT POST PREVENT DAYS"
; ^DD(344.61,.07,0) > "PHARMACY EFT POST PREVENT DAYS"
; ^DD(344.61,.13,0) > "TRICARE EFT POST PREVENT DAYS"
D AD2RPT("### EFT Lock-Out Parameters ###")
F RCFLD=.06,.07,.13 D
. Q:(RCFLD=.06)&'((RCTYPE="M")!(RCTYPE="A")) ; Don't display if not showing Medical parameters
. Q:(RCFLD=.07)&'((RCTYPE="P")!(RCTYPE="A")) ; Don't display if not showing Rx parameters
. Q:(RCFLD=.13)&'((RCTYPE="T")!(RCTYPE="A")) ; PRCA*4.5*349 - Don't display if not showing TRICARE params
. S Y=$$GET1^DID(344.61,RCFLD,,"TITLE")_" "_@RCGLB(344.61)@(344.61,"1,",RCFLD,"E")
. D AD2RPT(Y)
;
D AD2RPT(" "),AD2RPT($$ENDORPRT^RCDPEARL)
;
I RCLSTMGR Q ; PRCA*4.5*349 - If displaying as ListMan report, return here and let ListMan handle it
;
S RCSTOP=0
U IO
D SPHDR(.RCHDR)
S J=0
F S J=$O(^TMP($J,"RC SP REPORT",J)) Q:'J!RCSTOP S Y=^TMP($J,"RC SP REPORT",J,0) D
. W !,Y Q:'$O(^TMP($J,"RC SP REPORT",J)) ; quit if last line
. I '$G(ZTSK),$E(IOST,1,2)="C-",$Y+3>IOSL D Q
. . D ASK^RCDPEARL(.RCSTOP)
. . I 'RCSTOP D SPHDR(.RCHDR)
. Q:RCSTOP Q:$Y+2<IOSL
. D SPHDR(.RCHDR)
;
I '$G(ZTSK),$E(IOST,1,2)="C-",'RCSTOP D ASK^RCDPEARL(.RCSTOP)
;
; close device
U IO(0) D ^%ZISC
K @RCGLB(344.6) ; delete old data
S X="RC" F S X=$O(^TMP($J,X)) Q:'($E(X,1,2)="RC") K ^TMP($J,X) ; clean up
;
Q
;
; PRCA*4.5*349 - MPARAMS, RXPARAMS, TPARAMS moved to RCDPESPC
;
SPHDR(HDR) ; HDR passed by ref.
; HDR("RUNDATE") - run date, external format
; HDR("PGNMBR") - page number
; HDR("SITE") - site name
N CTLST,CUR,I,P,X,Y
S P=$G(HDR("PGNMBR"))+1,HDR("PGNMBR")=P ; increment page count
;
S X=$$HDRLN
S P=IOM-($L(X)+10)\2,Y=$J(" ",P)_X_$J(" ",P)_" Page: "_HDR("PGNMBR")
W @IOF,Y
S X=" Run Date: "_HDR("RUNDATE"),Y=X_$J(HDR("SITE"),IOM-($L(X)+1))
W !,Y
; PRCA*4.5*349 - Added categories to report header
; Add categories
S Y=" Categories: "
S CNT=$L(RCCATS,U),CUR=""
D LSTCATS^RCDPESPC(.CTLST,1)
S CTLST("AL")="All"
F I=1:1:CNT D
. S X=$G(CTLST($P(RCCATS,U,I)))
. I ($L(Y)+$L(X))>IOM D
. . W !,Y
. . S Y=" "
. S Y=Y_X
. I I<CNT S Y=Y_", "
W !,Y
S Y=" "_$TR($J("",IOM-2)," ","-") ; space_row of hyphens
W !,Y
Q
;
AD2RPT(A) ; add line to report
Q:$G(A)=""
N C S C=$G(^TMP($J,"RC SP REPORT",0))+1,^TMP($J,"RC SP REPORT",0)=C
; PRCA*4.5*349 - Add data to global depending on whether we're displaying in ListMan or not
I '$G(RCLSTMGR) S ^TMP($J,"RC SP REPORT",C,0)=A
E S ^TMP($J,"RC SP REPORT",C)=A
Q
;
HDRLN() ; Display report header line
N XX,YY
S YY=$G(RCTYPE)
S XX=" - "_$S(YY="A":"ALL",YY="M":"MEDICAL",YY="P":"PHARMACY",YY="T":"TRICARE",1:"") ; PRCA*4.5*349
Q "EDI Lockbox Parameters Report"_XX
;
CARCCHK(RCTYPE,PAID,TYPE) ; Checks to see if CARC parameters should appear on the report
; PRCA*4.5*349 - Reworte function
; Input: RCTYPE - User selected filter (M/P/T/A)
; PAID - 1 - Auto-Decrease for Claims w/Payments
; 0 - Auto-Decrease for Claims w/No Payments
; TYPE - Type currently being processed (M/P/T)
; Returns 1 - If Auto-Decreased is enabled for TYPE and it was in selected filter
; 0 - Otherwise
N RCMEN,RCREN,XX
I TYPE="M" D Q XX ; Check Medical Auto-Decrease values
. I RCTYPE'="A",RCTYPE'="M" S XX=0 Q
. I PAID D Q ; Auto-Decrease of Med Claims w/Payments
. . S XX=+$P($G(^RCY(344.61,1,0)),U,3)
. I 'PAID D Q ; Auto-Decrease of Med Claims w/No Payments
. . S XX=+$P($G(^RCY(344.61,1,0)),U,11)
;
I TYPE="P" D Q XX ; Check Rx Auto-Decrease values
. I RCTYPE'="A",RCTYPE'="P" S XX=0 Q
. S XX=+$P($G(^RCY(344.61,1,1)),U,2)
;
I TYPE="T" D Q XX ; Check TRICARE Auto-Decrease values
. I RCTYPE'="A",RCTYPE'="T" S XX=0 Q
. I PAID D Q ; Auto-Decrease of TRICARE Claims w/Payments
. . S XX=+$P($G(^RCY(344.61,1,1)),U,6)
. I 'PAID D Q ; Auto-Decrease of TRICARE Claims w/No Payments
. . S XX=+$P($G(^RCY(344.61,1,0)),U,9)
Q 0 ; Don't print the CARCs
;
MEDAUTOP(RCPARM) ; Display Medical Auto-Post parameters - PRCA*4.5*349
; Input: RCPARM("AUTO-DECREASE") - 1 if Medical Auto-Posting is turned for claims w/Payments
; 0 otherwise
D AUTOP(.RCPARM,0)
Q
;
RXAUTOP(RCPARM) ; Display Pharmacy Auto-Post parameters - PRCA*4.5*349
; Input: RCPARM("RX AUTO-DECREASE") - 1 if Rx Auto-Posting is turned for claims w/Payments
; 0 otherwise
D AUTOP(.RCPARM,1)
Q
;
TRIAUTOP(RCPARM) ; Display TRICARE Auto-Post parameters - PRCA*4.5*349
; Input: RCPARM("TRI AUTO-DECREASE") - 1 if TRICARE Auto-Posting is turned for claims w/Payments
; 0 otherwise
D AUTOP(.RCPARM,2)
Q
;
AUTOP(RCPARM,WHICH) ; Display auto-post parameters - PCRA*4.5*349
; Input: RCPARM("AUTO-DECREASE") - 1 if Medical Auto-Posting is turned for claims w/Payments
; 0 otherwise
; RCPARM("RX AUTO-DECREASE") - 1 if Rx Auto-Posting is turned for claims w/Payments
; 0 otherwise
; RCPARM("TRI AUTO-DECREASE") - 1 if TRICARE Auto-Posting is turned for claims w/Payments
; 0 otherwise
; WHICH - 0 - Medical, 1 - Rx, 2 - TRICARE
; @RCGLB(344.6) - LIST^DIC array of fields
; @RCGLB(344.61) - LIST^DIC array of fields
N FLDS,SCRN,RCNTR,V,X,Y
S FLDS="@;.01;.02;"_$S(WHICH=1:".08;3",WHICH=2:".13;5",1:".06;1")
S SCRN="I $P(^(0),U,"_$S(WHICH=1:"8",WHICH=2:"13",1:"6")_")=1"
D LIST^DIC(344.6,,FLDS,"P",,,,,SCRN,,RCGLB(344.6))
S X=$$GET1^DID(344.61,$S(WHICH=1:1.01,WHICH=2:1.05,1:.02),,"TITLE") ; Auto-Post Rx/Tri/Med Claims Enabled
S V=" (Y/N)" S:X[V X=$P(X,V,1)_$S(WHICH=1:": ",1:$P(X,V,2)) ; Remove yes/no prompt
S Y=X_" "_@RCGLB(344.61)@(344.61,"1,",$S(WHICH=1:1.01,WHICH=2:1.05,1:.02),"E")
D AD2RPT(Y)
; list auto-post excluded payers
I (RCPARM($S(WHICH=1:"RX ",WHICH=2:"TRI ",1:"")_"AUTO-POST")!RCPARM($S(WHICH=1:"RX ",WHICH=2:"TRI ",1:"")_"AUTO-DECREASE")) D
. D OPPAYS($S(WHICH=1:"Pharmacy",WHICH=2:"TRICARE",1:"Medical")_" Auto-Posting") ; PRCA*4.5*345
. D AD2RPT(" ")
;
K @RCGLB(344.6) ; Delete old data
Q
;
MEDAUTOD(RCPARM,RCTYPE) ; Display auto-decrease parameters - PRCA*4.5*349
; Input: RCPARM("AUTO-DECREASE") - 1 if Medical Auto-Posting is turned for claims w/Payments
; 0 otherwise
; RCTYPE- Report type (M)edical, (P)harmacy, (T)RICARE or (A)ll
N FLDSS
Q:'((RCTYPE="M")!(RCTYPE="A"))
; RCDPE AUTO-PAY EXCLUSION file (#344.6)
; screening logic: ^DD(344.6,.07,0)="EXCLUDE MED CLAIMS DECREASE^S^0:No;1:Yes;^0;7^Q"
S FLDS="@;.01;.02;.07;2" ; PRCA*4.5*349 - Added line
D LIST^DIC(344.6,,FLDS,"P",,,,,"I $P(^(0),U,7)=1",,RCGLB(344.6)) ; PRCA*4.5*349
D AD2RPT(" ")
; Display Auto-Decrease parameters for paid lines
D AUTOD(1,0,.RCGLB,RCTYPE) ; PRCA*4.5*349
; Display Auto-Decrease parameters for no-pay lines
D AUTOD(0,0,.RCGLB,RCTYPE) ; PRCA*4.5*349
D AD2RPT(" ")
;
Q
RXAUTOD(RCPARM,RCTYPE) ; Display auto-decrease parameters - PRCA*4.5*349
; Input: RCPARM("RX AUTO-DECREASE") - 1 if Rx Auto-Posting is turned for claims w/Payments
; 0 otherwise
; RCTYPE- Report type (M)edical, (P)harmacy, (T)RICARE or (A)ll
N FLDS
Q:'((RCTYPE="P")!(RCTYPE="A"))
; Display Auto-Decrease parameters for paid lines
K @RCGLB(344.6) ; delete old data
; RCDPE AUTO-PAY EXCLUSION file (#344.6)
D LIST^DIC(344.6,,"@;.01;.02;.12;4","P",,,,,"I $P(^(0),U,12)=1",,RCGLB(344.6))
D AUTOD(1,1,.RCGLB,RCTYPE) ; PRCA*4.5*345
D AD2RPT(" ")
Q
TRIAUTOD(RCPARM,RCTYPE) ; Display auto-decrease parameters - PRCA*4.5*349
; Input: RCPARM("TRI AUTO-DECREASE") - 1 if TRICARE Auto-Posting is turned for claims w/Payments
; 0 otherwise
; RCTYPE- Report type (M)edical, (P)harmacy, (T)RICARE or (A)ll
N FLDS
Q:'((RCTYPE="T")!(RCTYPE="A"))
; RCDPE AUTO-PAY EXCLUSION file (#344.6)
; screening logic: ^DD(344.6,.14,0)="EXCLUDE TRICARE CLAIMS DECREASE^S^0:No;1:Yes;^0;7^Q"
S FLDS="@;.01;.02;.14;6"
D LIST^DIC(344.6,,FLDS,"P",,,,,"I $P(^(0),U,14)=1",,RCGLB(344.6))
;
; BEGIN PRCA*4.5*326
; Display Auto-Decrease parameters for paid lines
D AUTOD(1,2,.RCGLB,RCTYPE)
; Display Auto-Decrease parameters for no-pay lines
D AUTOD(0,2,.RCGLB,RCTYPE)
; END PRCA*4.5*326
;
D AD2RPT(" ")
Q
; BEGIN - PRCA*4.5*326
AUTOD(PAID,WHICH,RCGLB,RCTYPE) ; Display auto-decrease parameters - PRCA*4.5*345
; PRCA*4.5*349 - Added TRICARE
; Input: PAID - 1 - Claims with Payments parameters
; 0 - Claims with No Payments parameters
; RCGLB - Field value array from LIST^DIC call
; WHICH - 0 - Medical, 1 - Rx, 2 - TRICARE
; RCTYPE- Report type (M)edical, (P)harmacy, (T)RICARE or (A)ll
; RCPARM(344.61,0) - ^RCY(344.61,1,0)
; RCPARM(344.61,1) - ^RCY(344.61,1,1)
; Output: Auto-Decrease parameters are added to the report
;
; PRCA*4.5*349 - Add ONOFF variable to whether auto-post is enabled/disabled for this type
N CNT,FIELD,ONOFF,RCCODE,RCI,X,XX,Y,YY
; Do not display Auto-Decrease questions when Auto-Post Disabled
S ONOFF=$$AUTOPON^RCDPESPC(WHICH)
I ONOFF=0 D Q
. N WNAME
. S WNAME=$S(WHICH=0:"Medical",WHICH=1:"Pharmacy",1:"TRICARE")
. D AD2RPT("NOTICE: "_WNAME_" Auto-Decrease unavailable because Auto-Posting of "_WNAME_" Claims is currently disabled")
; RCDPE PARAMETER file (#344.61), auto-decrease of medical claims
I WHICH=0 S FIELD=$S(PAID:.03,1:.11)
E I WHICH=1 S FIELD=1.02
E S FIELD=$S(PAID:1.06,1:1.09) ; PRCA*4.5*349
S X=$$GET1^DID(344.61,FIELD,,"TITLE")
I X[" (Y/N): " S X=$P(X," (Y/N): ")_": " ; remove yes/no prompt
S Y=$J(X,45)_@RCGLB(344.61)@(344.61,"1,",FIELD,"E")
D AD2RPT(" "),AD2RPT(Y)
I WHICH=0 S XX=RCPARM("AUTO-POST"),YY=RCPARM("AUTO-DECREASE") ; PRCA*4.5*349 - Added line
I WHICH=1 S XX=RCPARM("RX AUTO-POST"),YY=RCPARM("RX AUTO-DECREASE") ; PRCA*4.5*349 - Added line
I WHICH=2 S XX=RCPARM("TRI AUTO-POST"),YY=RCPARM("TRI AUTO-DECREASE") ; PRCA*4.5*349 - Added line
I PAID,(XX!YY) D ;
. D OPPAYS($S(WHICH=0:"Medical",WHICH=1:"Pharmacy",1:"TRICARE")_" Auto-Decrease") ; PRCA*4.5*349
. D AD2RPT(" ")
; If auto-decrease is off - do not display CARCS or auto-decrease days or auto-decrease maximum
I +$$GET1^DIQ(344.61,"1,",FIELD,"I")=0 Q
;
; PRCA*4.5*349 - Start modified block
S XX=$S(WHICH=0:"MEDICAL",WHICH=1:"PHARMACY",1:"TRICARE")
S YY="MAXIMUM DOLLAR AMOUNT TO AUTO-DECREASE PER "_XX_" CLAIM: "_"$"
S XX=""
I WHICH=0 D ;
. I PAID S XX=YY_$$GET1^DIQ(344.61,"1,",.05,"E")
I WHICH=1 S XX=YY_$$GET1^DIQ(344.61,"1,",1.04,"E")
I WHICH=2 D ;
. I PAID S XX=YY_$$GET1^DIQ(344.61,"1,",1.07,"E")
I XX'="" D AD2RPT(XX)
; PRCA*4.5*349 - End modified block
;
S CNT=0
; Print the CARC Auto-decrease parameters
I $$CARCCHK(RCTYPE,PAID,$S(WHICH=0:"M",WHICH=1:"P",1:"T")) D ; PRCA*4.5*349
. D AD2RPT(" ")
. S X=" AUTO-DECREASE "_$S(PAID:"PAID",1:"NO-PAY")
. S X=X_" "_$S(WHICH=0:"MEDICAL",WHICH=1:"PHARAMCY",1:"TRICARE")
. S X=X_" CLAIMS FOR THE FOLLOWING CARC/AMOUNTS ONLY:"
. D AD2RPT(X)
. D AD2RPT(" ")
. S RCSTRING=$TR($J("",70)," ","-"),RCI=0
. D AD2RPT(" CARC Description Max. Amt")
. D AD2RPT(" "_RCSTRING)
. ;
. ; Loop and print entries
. S RCCODE="" F S RCCODE=$O(^RCY(344.62,"B",RCCODE)) Q:RCCODE="" D ; PRCA*4.5*349 - Sort CARC entries by CARC code instead of by most recently entered
. . S RCI=0 F S RCI=$O(^RCY(344.62,"B",RCCODE,RCI)) Q:'RCI D ; PRCA*4.5*349 - Sort CARC entries by CARC code instead of by most recently entered
. . . S RCCIEN=$O(^RC(345,"B",RCCODE,""))
. . . S RCDESC=$G(^RC(345,RCCIEN,1,1,0)) ; WP field 345.04
. . . I WHICH=0 S FIELD=$S(PAID:.02,1:.08)
. . . I WHICH=1 S FIELD=2.01
. . . I WHICH=2 S FIELD=$S(PAID:3.01,1:3.07)
. . . S RCSTAT=$$GET1^DIQ(344.62,RCI,FIELD,"I")
. . . Q:RCSTAT'=1
. . . S CNT=CNT+1
. . . I $L(RCDESC)>50 S RCDESC=$E(RCDESC,1,50)_"..."
. . . D GETCODES^RCDPCRR(RCCODE,"","A",$$DT^XLFDT,"RCCARCD","1^70")
. . . S Y=" "_$J(RCCODE,4)_" "_$E(RCDESC,1,53)
. . . S:$L(RCDESC)<53 Y=Y_$J("",(53-$L(RCDESC)))
. . . I WHICH=0 S FIELD=$S(PAID:.06,1:.12)
. . . I WHICH=1 S FIELD=2.05
. . . I WHICH=2 S FIELD=$S(PAID:3.05,1:3.11)
. . . S Y=Y_$J($$GET1^DIQ(344.62,RCI,FIELD,"I"),10,0)
. . . I '$$ACT^RCDPRU(345,RCCODE,) S Y=Y_" (I)" ; if inactive, display (i)
. . . D AD2RPT(Y)
. I CNT=0 D AD2RPT(" No CARCs are set up for "_$S(PAID:"",1:"NO-PAY ")_"auto-decrease")
;
; Display auto-decrease days
I WHICH=0 S FIELD=$S(PAID:.04,1:.12)
I WHICH=1 S FIELD=1.03
I WHICH=2 S FIELD=$S(PAID:1.08,1:1.1)
S X=$P($$GET1^DID(344.61,FIELD,,"TITLE")," (",1)_": "
S Y=$J(X,40)_@RCGLB(344.61)@(344.61,"1,",FIELD,"E")
D AD2RPT(" "),AD2RPT(Y)
Q
; END - PRCA*4.5*326
;
OPPAYS(RCTYPE) ; Output list of excluded payers - Added for PRCA*4.5*345
; Input: RCTYPE - Type of list being displayed. Free text.
; RCPARM - array assumed to exist and contain AUTO-POST and AUTO-DECREASE flags for MED or PHARM
; RCGLB - array assumed to exist and contain output from GETS^DIQ for payer exclusions
;
N X,XX
D AD2RPT(" ")
I '$D(@RCGLB(344.6)@("DILIST",1,0)) D Q
. S X=" No payers excluded from "_RCTYPE_"." D AD2RPT($J(" ",80-$L(X)\2)_X)
;
S XX=$P(RCTYPE," ",1)
S XX=$S(XX="Pharmacy":"Rx",1:$E(XX,1,3))
S XX=XX_" "_$P(RCTYPE," ",2,3)
S X=" Excluded Payer ("_XX_")"_$J("",19-$L(XX))_"Comment"
D AD2RPT(X)
S RCNTR=0 F S RCNTR=$O(@RCGLB(344.6)@("DILIST",RCNTR)) Q:'RCNTR D
. S V=@RCGLB(344.6)@("DILIST",RCNTR,0),X=$E($P(V,U,2),1,35)
. S Y=" "_X_$J(" ",36-$L(X))_$P(V,U,5) D AD2RPT($E(Y,1,IOM))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESP1 19746 printed Apr 09, 2024@20:54:28 Page 2
RCDPESP1 ;BIRM/SAB - ePayment Lockbox Site Parameter Reports ;29 Jan 2019 18:00:14
+1 ;;4.5;Accounts Receivable;**298,304,318,321,326,332,345,349**;Mar 20, 1995;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
RPT ; EDI Lockbox Parameters Report [RCDPE SITE PARAMETER REPORT]
+1 ; report data from:
+2 ; AR SITE PARAMETER file (#342)
+3 ; RCDPE PARAMETER file (#344.61)
+4 ; RCDPE AUTO-PAY EXCLUSION file (#344.6)
+5 ;
+6 ; LOCAL VARIABLES:
+7 ; RTYPE - Type of Report to run (Medical, Pharmacy, or Both)
+8 ;
+9 ; PRCA*4.5*349 - Add categories prompt
+10 NEW %ZIS,POP,RCCATS,RCHDR,RCLSTMGR,RCTEMP,RCTMPND,RCTYPE
+11 SET RCCATS=$$CATS^RCDPESPC
+12 IF RCCATS=""
DO RPTQ
QUIT
+13 WRITE !,$$HDRLN,!
+14 ;
+15 SET RCTYPE=$$RTYPE^RCDPESP2
+16 IF RCTYPE=-1
DO RPTQ
QUIT
+17 ; PRCA*4.5*349 - Start modified code block
+18 ; Ask to Display in Listman Template
SET RCLSTMGR=$$ASKLM^RCDPEARL
+19 ; '^' or timeout
if RCLSTMGR<0
QUIT
+20 ;
IF RCLSTMGR
Begin DoDot:1
+21 SET RCTMPND="RC SP REPORT"
+22 KILL ^TMP($JOB,RCTMPND)
+23 ;
IF RCCATS="AL"
Begin DoDot:2
+24 DO SPRPT
End DoDot:2
+25 ;
IF '$TEST
Begin DoDot:2
+26 DO SPRPT^RCDPESPC
End DoDot:2
+27 DO LMHDR^RCDPESPC(.RCHDR,RCTYPE,RCCATS)
+28 SET RCTEMP="RCDPE PARAMETERS REPORT"
+29 ; Generate ListMan display
DO LMRPT^RCDPEARL(.RCHDR,$NAME(^TMP($JOB,RCTMPND)),RCTEMP)
+30 KILL ^TMP($JOB,RCTMPND)
End DoDot:1
DO RPTQ
QUIT
+31 ; PRCA*4.5*349 - End modified code block
+32 ; skip lines before device prompt
WRITE !!
+33 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+34 IF $DATA(IO("Q"))
Begin DoDot:1
+35 NEW ZTDESC,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK
+36 ; PRCA*4.5*349 - Task subroutine based on whether "All" or some cats were chosen
+37 SET ZTRTN=$SELECT(RCCATS="AL":"SPRPT",1:"SPRPT2")_"^RCDPESP1"
SET ZTDESC=$$HDRLN
SET ZTSAVE("RC*")=""
+38 DO ^%ZTLOAD
+39 WRITE !!,$SELECT($GET(ZTSK):"Task number "_ZTSK_" has been queued.",1:"Unable to queue this task.")
+40 KILL IO("Q")
DO HOME^%ZIS
End DoDot:1
QUIT
+41 ;
+42 ; PRCA*4.5*349 - Call correct subroutine depending on whether "All" cats are shown or not
+43 IF RCCATS="AL"
DO SPRPT
QUIT
+44 DO SPRPT^RCDPESPC
+45 ;
RPTQ ;
+1 QUIT
+2 ;
SPRPT ; site parameter report entry point
+1 ; Input: RCTYPE - Type of report (Medical/Rx/TRICARE/All)
+2 ; RCCATS - List of categories selected for report
+3 ; RCNTR - counter
+4 ; RCFLD - DD field number
+5 ; RCHDR - header information
+6 ; RCPARM - parameters
+7 ; RCSTOP - exit flag
+8 NEW FLDS,J,RCACTV,RCCARCD,RCCIEN,RCCODE,RCDATA,RCDESC,RCFLD,RCGLB,RCHDR,RCI,RCITEM
+9 NEW RCNTR,RCPARM,RCSTAT,RCSTOP,RCSTRING,V,X,XX,Y,YY
+10 ;
+11 SET X="RC"
+12 ; clear out old data
FOR
SET X=$ORDER(^TMP($JOB,X))
if '($EXTRACT(X,1,2)="RC")
QUIT
KILL ^TMP($JOB,X)
+13 ;
+14 ; RCGLB - ^TMP global storage locations
+15 ; ^TMP($J,"RC342") - AR SITE PARAMETER file (#342)
+16 ; ^TMP($J,"RC344.6") - RCDPE AUTO-PAY EXCLUSION file (#344.6)
+17 ; ^TMP($J,"RC344.61") - RCDPE PARAMETER file (#344.61)
+18 ;
FOR J=342,344.6,344.61
Begin DoDot:1
+19 SET RCGLB(J)=$NAME(^TMP($JOB,"RC"_J))
+20 KILL @RCGLB(J)
End DoDot:1
+21 ;
+22 SET RCHDR("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"10S")
+23 ; page number
SET RCHDR("PGNMBR")=0
+24 ;
+25 ; AR SITE PARAMETER file (#342)
+26 ; PRCA*4.5*345
DO GETS^DIQ(342,"1,",".01;.14;.15;7.02;7.03;7.04;7.05;7.06;7.07;7.08;7.09","E",RCGLB(342))
+27 ; add site to header data
+28 SET RCHDR("SITE")="Site: "_@RCGLB(342)@(342,"1,",.01,"E")
+29 ;
+30 ; PRCA*4.5*345 add field .14 and .15 for first party auto-decrease
+31 DO AD2RPT("### EDI Lockbox Site & First Party Parameters ###")
+32 ; EFT and ERA days unmatched - PRCA*4.5*321
FOR RCFLD=7.02,7.03,7.04,.14,.15,7.05,7.06,7.07,7.08,7.09
Begin DoDot:1
+33 IF RCFLD=7.05
DO AD2RPT(" ")
DO AD2RPT("### Auto-Audit Site Parameters ###")
+34 ; PRCA*4.5*345
SET RCITEM=$SELECT(RCFLD=.14!(RCFLD=.15)!(RCFLD>7.04):"TITLE",1:"LABEL")
+35 ; PRCA*4.5*349 Exclude TRICARE
IF RCTYPE="P"
IF (RCFLD=7.05)!(RCFLD=7.07)!(RCFLD=7.09)
QUIT
+36 ; PRCA*4.5*349 Exclude TRICARE
IF RCTYPE="M"
IF (RCFLD=7.06)!(RCFLD=7.08)!(RCFLD=7.09)
QUIT
+37 ; PRCA*4.5*349 Line Added TRICARE
IF RCTYPE="T"
IF RCFLD>7.04
IF RCFLD<7.09
QUIT
+38 SET Y=$$GET1^DID(342,RCFLD,,RCITEM)_": "_@RCGLB(342)@(342,"1,",RCFLD,"E")
+39 IF RCFLD=7.05
DO AD2RPT(" ")
+40 IF (RCFLD=7.06)
IF (RCTYPE="P")
DO AD2RPT(" ")
+41 IF (RCFLD=7.09)
IF (RCTYPE="T")
DO AD2RPT(" ")
+42 DO AD2RPT(Y)
End DoDot:1
+43 ;
+44 DO AD2RPT(" ")
+45 ;
+46 ; Display Parameters
+47 ; RCDPE PARAMETER file (#344.61)
+48 SET Y=".02;.03;.04;.05;.06;.07;.1;.11;.12;.13;1.01;1.02;1.03;1.04"
+49 ; PRCA*4.5*349 - Add TRICARE
SET Y=Y_";1.05;1.06;1.07;1.08;1.09;1.1"
+50 DO GETS^DIQ(344.61,"1,",Y,"E",RCGLB(344.61))
+51 ;
+52 ; PRCA*4.5*321
SET Y=$$GET1^DID(344.61,.1,,"LABEL")_": "_@RCGLB(344.61)@(344.61,"1,",.1,"E")
+53 DO AD2RPT("### Workload Notification Day Parameter ###")
+54 ; PRCA*4.5*321
DO AD2RPT(Y)
DO AD2RPT(" ")
+55 ;
+56 ; get auto-post and auto-decrease settings, save zero node
+57 SET X=$GET(^RCY(344.61,1,0))
+58 ; PRCA*4.5*349 - Added line
SET XX=$GET(^RCY(344.61,1,1))
+59 SET RCPARM("AUTO-POST")=$PIECE(X,U,2)
+60 SET RCPARM("AUTO-DECREASE")=$PIECE(X,U,3)
+61 SET RCPARM(344.61,0)=X
+62 ; PRCA*4.5*349 - Added line
SET RCPARM(344.61,1)=XX
+63 SET RCPARM("RX AUTO-POST")=$PIECE(XX,U,1)
+64 ; PRCA*4.5*349 - Added line
SET RCPARM("RX AUTO-DECREASE")=$PIECE(XX,U,2)
+65 ; PRCA*4.5*349 - Added line
SET RCPARM("TRI AUTO-POST")=$PIECE(XX,U,5)
+66 ; PRCA*4.5*349 - Added line
SET RCPARM("TRI AUTO-DECREASE")=$PIECE(XX,U,6)
+67 ;
+68 ; PRCA*4.5*349 - Start modified block - Move code into subroutines for easier maintenance
+69 ; Display Medical Claim parameters
IF (RCTYPE="M")!(RCTYPE="A")
DO MPARAMS^RCDPESPC(.RCPARM)
+70 ;
+71 ; Display Rx parameters
IF (RCTYPE="P")!(RCTYPE="A")
DO RXPARAMS^RCDPESPC(.RCPARM)
+72 ;
+73 ; Display Rx parameters
IF (RCTYPE="T")!(RCTYPE="A")
DO TPARAMS^RCDPESPC(.RCPARM)
+74 ; PRCA*4.5*349 - End modified block
+75 ;
+76 ; RCDPE PARAMETER file (#344.61)
+77 ; ^DD(344.61,.06,0) > "MEDICAL EFT POST PREVENT DAYS"
+78 ; ^DD(344.61,.07,0) > "PHARMACY EFT POST PREVENT DAYS"
+79 ; ^DD(344.61,.13,0) > "TRICARE EFT POST PREVENT DAYS"
+80 DO AD2RPT("### EFT Lock-Out Parameters ###")
+81 FOR RCFLD=.06,.07,.13
Begin DoDot:1
+82 ; Don't display if not showing Medical parameters
if (RCFLD=.06)&'((RCTYPE="M")!(RCTYPE="A"))
QUIT
+83 ; Don't display if not showing Rx parameters
if (RCFLD=.07)&'((RCTYPE="P")!(RCTYPE="A"))
QUIT
+84 ; PRCA*4.5*349 - Don't display if not showing TRICARE params
if (RCFLD=.13)&'((RCTYPE="T")!(RCTYPE="A"))
QUIT
+85 SET Y=$$GET1^DID(344.61,RCFLD,,"TITLE")_" "_@RCGLB(344.61)@(344.61,"1,",RCFLD,"E")
+86 DO AD2RPT(Y)
End DoDot:1
+87 ;
+88 DO AD2RPT(" ")
DO AD2RPT($$ENDORPRT^RCDPEARL)
+89 ;
+90 ; PRCA*4.5*349 - If displaying as ListMan report, return here and let ListMan handle it
IF RCLSTMGR
QUIT
+91 ;
+92 SET RCSTOP=0
+93 USE IO
+94 DO SPHDR(.RCHDR)
+95 SET J=0
+96 FOR
SET J=$ORDER(^TMP($JOB,"RC SP REPORT",J))
if 'J!RCSTOP
QUIT
SET Y=^TMP($JOB,"RC SP REPORT",J,0)
Begin DoDot:1
+97 ; quit if last line
WRITE !,Y
if '$ORDER(^TMP($JOB,"RC SP REPORT",J))
QUIT
+98 IF '$GET(ZTSK)
IF $EXTRACT(IOST,1,2)="C-"
IF $Y+3>IOSL
Begin DoDot:2
+99 DO ASK^RCDPEARL(.RCSTOP)
+100 IF 'RCSTOP
DO SPHDR(.RCHDR)
End DoDot:2
QUIT
+101 if RCSTOP
QUIT
if $Y+2<IOSL
QUIT
+102 DO SPHDR(.RCHDR)
End DoDot:1
+103 ;
+104 IF '$GET(ZTSK)
IF $EXTRACT(IOST,1,2)="C-"
IF 'RCSTOP
DO ASK^RCDPEARL(.RCSTOP)
+105 ;
+106 ; close device
+107 USE IO(0)
DO ^%ZISC
+108 ; delete old data
KILL @RCGLB(344.6)
+109 ; clean up
SET X="RC"
FOR
SET X=$ORDER(^TMP($JOB,X))
if '($EXTRACT(X,1,2)="RC")
QUIT
KILL ^TMP($JOB,X)
+110 ;
+111 QUIT
+112 ;
+113 ; PRCA*4.5*349 - MPARAMS, RXPARAMS, TPARAMS moved to RCDPESPC
+114 ;
SPHDR(HDR) ; HDR passed by ref.
+1 ; HDR("RUNDATE") - run date, external format
+2 ; HDR("PGNMBR") - page number
+3 ; HDR("SITE") - site name
+4 NEW CTLST,CUR,I,P,X,Y
+5 ; increment page count
SET P=$GET(HDR("PGNMBR"))+1
SET HDR("PGNMBR")=P
+6 ;
+7 SET X=$$HDRLN
+8 SET P=IOM-($LENGTH(X)+10)\2
SET Y=$JUSTIFY(" ",P)_X_$JUSTIFY(" ",P)_" Page: "_HDR("PGNMBR")
+9 WRITE @IOF,Y
+10 SET X=" Run Date: "_HDR("RUNDATE")
SET Y=X_$JUSTIFY(HDR("SITE"),IOM-($LENGTH(X)+1))
+11 WRITE !,Y
+12 ; PRCA*4.5*349 - Added categories to report header
+13 ; Add categories
+14 SET Y=" Categories: "
+15 SET CNT=$LENGTH(RCCATS,U)
SET CUR=""
+16 DO LSTCATS^RCDPESPC(.CTLST,1)
+17 SET CTLST("AL")="All"
+18 FOR I=1:1:CNT
Begin DoDot:1
+19 SET X=$GET(CTLST($PIECE(RCCATS,U,I)))
+20 IF ($LENGTH(Y)+$LENGTH(X))>IOM
Begin DoDot:2
+21 WRITE !,Y
+22 SET Y=" "
End DoDot:2
+23 SET Y=Y_X
+24 IF I<CNT
SET Y=Y_", "
End DoDot:1
+25 WRITE !,Y
+26 ; space_row of hyphens
SET Y=" "_$TRANSLATE($JUSTIFY("",IOM-2)," ","-")
+27 WRITE !,Y
+28 QUIT
+29 ;
AD2RPT(A) ; add line to report
+1 if $GET(A)=""
QUIT
+2 NEW C
SET C=$GET(^TMP($JOB,"RC SP REPORT",0))+1
SET ^TMP($JOB,"RC SP REPORT",0)=C
+3 ; PRCA*4.5*349 - Add data to global depending on whether we're displaying in ListMan or not
+4 IF '$GET(RCLSTMGR)
SET ^TMP($JOB,"RC SP REPORT",C,0)=A
+5 IF '$TEST
SET ^TMP($JOB,"RC SP REPORT",C)=A
+6 QUIT
+7 ;
HDRLN() ; Display report header line
+1 NEW XX,YY
+2 SET YY=$GET(RCTYPE)
+3 ; PRCA*4.5*349
SET XX=" - "_$SELECT(YY="A":"ALL",YY="M":"MEDICAL",YY="P":"PHARMACY",YY="T":"TRICARE",1:"")
+4 QUIT "EDI Lockbox Parameters Report"_XX
+5 ;
CARCCHK(RCTYPE,PAID,TYPE) ; Checks to see if CARC parameters should appear on the report
+1 ; PRCA*4.5*349 - Reworte function
+2 ; Input: RCTYPE - User selected filter (M/P/T/A)
+3 ; PAID - 1 - Auto-Decrease for Claims w/Payments
+4 ; 0 - Auto-Decrease for Claims w/No Payments
+5 ; TYPE - Type currently being processed (M/P/T)
+6 ; Returns 1 - If Auto-Decreased is enabled for TYPE and it was in selected filter
+7 ; 0 - Otherwise
+8 NEW RCMEN,RCREN,XX
+9 ; Check Medical Auto-Decrease values
IF TYPE="M"
Begin DoDot:1
+10 IF RCTYPE'="A"
IF RCTYPE'="M"
SET XX=0
QUIT
+11 ; Auto-Decrease of Med Claims w/Payments
IF PAID
Begin DoDot:2
+12 SET XX=+$PIECE($GET(^RCY(344.61,1,0)),U,3)
End DoDot:2
QUIT
+13 ; Auto-Decrease of Med Claims w/No Payments
IF 'PAID
Begin DoDot:2
+14 SET XX=+$PIECE($GET(^RCY(344.61,1,0)),U,11)
End DoDot:2
QUIT
End DoDot:1
QUIT XX
+15 ;
+16 ; Check Rx Auto-Decrease values
IF TYPE="P"
Begin DoDot:1
+17 IF RCTYPE'="A"
IF RCTYPE'="P"
SET XX=0
QUIT
+18 SET XX=+$PIECE($GET(^RCY(344.61,1,1)),U,2)
End DoDot:1
QUIT XX
+19 ;
+20 ; Check TRICARE Auto-Decrease values
IF TYPE="T"
Begin DoDot:1
+21 IF RCTYPE'="A"
IF RCTYPE'="T"
SET XX=0
QUIT
+22 ; Auto-Decrease of TRICARE Claims w/Payments
IF PAID
Begin DoDot:2
+23 SET XX=+$PIECE($GET(^RCY(344.61,1,1)),U,6)
End DoDot:2
QUIT
+24 ; Auto-Decrease of TRICARE Claims w/No Payments
IF 'PAID
Begin DoDot:2
+25 SET XX=+$PIECE($GET(^RCY(344.61,1,0)),U,9)
End DoDot:2
QUIT
End DoDot:1
QUIT XX
+26 ; Don't print the CARCs
QUIT 0
+27 ;
MEDAUTOP(RCPARM) ; Display Medical Auto-Post parameters - PRCA*4.5*349
+1 ; Input: RCPARM("AUTO-DECREASE") - 1 if Medical Auto-Posting is turned for claims w/Payments
+2 ; 0 otherwise
+3 DO AUTOP(.RCPARM,0)
+4 QUIT
+5 ;
RXAUTOP(RCPARM) ; Display Pharmacy Auto-Post parameters - PRCA*4.5*349
+1 ; Input: RCPARM("RX AUTO-DECREASE") - 1 if Rx Auto-Posting is turned for claims w/Payments
+2 ; 0 otherwise
+3 DO AUTOP(.RCPARM,1)
+4 QUIT
+5 ;
TRIAUTOP(RCPARM) ; Display TRICARE Auto-Post parameters - PRCA*4.5*349
+1 ; Input: RCPARM("TRI AUTO-DECREASE") - 1 if TRICARE Auto-Posting is turned for claims w/Payments
+2 ; 0 otherwise
+3 DO AUTOP(.RCPARM,2)
+4 QUIT
+5 ;
AUTOP(RCPARM,WHICH) ; Display auto-post parameters - PCRA*4.5*349
+1 ; Input: RCPARM("AUTO-DECREASE") - 1 if Medical Auto-Posting is turned for claims w/Payments
+2 ; 0 otherwise
+3 ; RCPARM("RX AUTO-DECREASE") - 1 if Rx Auto-Posting is turned for claims w/Payments
+4 ; 0 otherwise
+5 ; RCPARM("TRI AUTO-DECREASE") - 1 if TRICARE Auto-Posting is turned for claims w/Payments
+6 ; 0 otherwise
+7 ; WHICH - 0 - Medical, 1 - Rx, 2 - TRICARE
+8 ; @RCGLB(344.6) - LIST^DIC array of fields
+9 ; @RCGLB(344.61) - LIST^DIC array of fields
+10 NEW FLDS,SCRN,RCNTR,V,X,Y
+11 SET FLDS="@;.01;.02;"_$SELECT(WHICH=1:".08;3",WHICH=2:".13;5",1:".06;1")
+12 SET SCRN="I $P(^(0),U,"_$SELECT(WHICH=1:"8",WHICH=2:"13",1:"6")_")=1"
+13 DO LIST^DIC(344.6,,FLDS,"P",,,,,SCRN,,RCGLB(344.6))
+14 ; Auto-Post Rx/Tri/Med Claims Enabled
SET X=$$GET1^DID(344.61,$SELECT(WHICH=1:1.01,WHICH=2:1.05,1:.02),,"TITLE")
+15 ; Remove yes/no prompt
SET V=" (Y/N)"
if X[V
SET X=$PIECE(X,V,1)_$SELECT(WHICH=1:": ",1:$PIECE(X,V,2))
+16 SET Y=X_" "_@RCGLB(344.61)@(344.61,"1,",$SELECT(WHICH=1:1.01,WHICH=2:1.05,1:.02),"E")
+17 DO AD2RPT(Y)
+18 ; list auto-post excluded payers
+19 IF (RCPARM($SELECT(WHICH=1:"RX ",WHICH=2:"TRI ",1:"")_"AUTO-POST")!RCPARM($SELECT(WHICH=1:"RX ",WHICH=2:"TRI ",1:"")_"AUTO-DECREASE"))
Begin DoDot:1
+20 ; PRCA*4.5*345
DO OPPAYS($SELECT(WHICH=1:"Pharmacy",WHICH=2:"TRICARE",1:"Medical")_" Auto-Posting")
+21 DO AD2RPT(" ")
End DoDot:1
+22 ;
+23 ; Delete old data
KILL @RCGLB(344.6)
+24 QUIT
+25 ;
MEDAUTOD(RCPARM,RCTYPE) ; Display auto-decrease parameters - PRCA*4.5*349
+1 ; Input: RCPARM("AUTO-DECREASE") - 1 if Medical Auto-Posting is turned for claims w/Payments
+2 ; 0 otherwise
+3 ; RCTYPE- Report type (M)edical, (P)harmacy, (T)RICARE or (A)ll
+4 NEW FLDSS
+5 if '((RCTYPE="M")!(RCTYPE="A"))
QUIT
+6 ; RCDPE AUTO-PAY EXCLUSION file (#344.6)
+7 ; screening logic: ^DD(344.6,.07,0)="EXCLUDE MED CLAIMS DECREASE^S^0:No;1:Yes;^0;7^Q"
+8 ; PRCA*4.5*349 - Added line
SET FLDS="@;.01;.02;.07;2"
+9 ; PRCA*4.5*349
DO LIST^DIC(344.6,,FLDS,"P",,,,,"I $P(^(0),U,7)=1",,RCGLB(344.6))
+10 DO AD2RPT(" ")
+11 ; Display Auto-Decrease parameters for paid lines
+12 ; PRCA*4.5*349
DO AUTOD(1,0,.RCGLB,RCTYPE)
+13 ; Display Auto-Decrease parameters for no-pay lines
+14 ; PRCA*4.5*349
DO AUTOD(0,0,.RCGLB,RCTYPE)
+15 DO AD2RPT(" ")
+16 ;
+17 QUIT
RXAUTOD(RCPARM,RCTYPE) ; Display auto-decrease parameters - PRCA*4.5*349
+1 ; Input: RCPARM("RX AUTO-DECREASE") - 1 if Rx Auto-Posting is turned for claims w/Payments
+2 ; 0 otherwise
+3 ; RCTYPE- Report type (M)edical, (P)harmacy, (T)RICARE or (A)ll
+4 NEW FLDS
+5 if '((RCTYPE="P")!(RCTYPE="A"))
QUIT
+6 ; Display Auto-Decrease parameters for paid lines
+7 ; delete old data
KILL @RCGLB(344.6)
+8 ; RCDPE AUTO-PAY EXCLUSION file (#344.6)
+9 DO LIST^DIC(344.6,,"@;.01;.02;.12;4","P",,,,,"I $P(^(0),U,12)=1",,RCGLB(344.6))
+10 ; PRCA*4.5*345
DO AUTOD(1,1,.RCGLB,RCTYPE)
+11 DO AD2RPT(" ")
+12 QUIT
TRIAUTOD(RCPARM,RCTYPE) ; Display auto-decrease parameters - PRCA*4.5*349
+1 ; Input: RCPARM("TRI AUTO-DECREASE") - 1 if TRICARE Auto-Posting is turned for claims w/Payments
+2 ; 0 otherwise
+3 ; RCTYPE- Report type (M)edical, (P)harmacy, (T)RICARE or (A)ll
+4 NEW FLDS
+5 if '((RCTYPE="T")!(RCTYPE="A"))
QUIT
+6 ; RCDPE AUTO-PAY EXCLUSION file (#344.6)
+7 ; screening logic: ^DD(344.6,.14,0)="EXCLUDE TRICARE CLAIMS DECREASE^S^0:No;1:Yes;^0;7^Q"
+8 SET FLDS="@;.01;.02;.14;6"
+9 DO LIST^DIC(344.6,,FLDS,"P",,,,,"I $P(^(0),U,14)=1",,RCGLB(344.6))
+10 ;
+11 ; BEGIN PRCA*4.5*326
+12 ; Display Auto-Decrease parameters for paid lines
+13 DO AUTOD(1,2,.RCGLB,RCTYPE)
+14 ; Display Auto-Decrease parameters for no-pay lines
+15 DO AUTOD(0,2,.RCGLB,RCTYPE)
+16 ; END PRCA*4.5*326
+17 ;
+18 DO AD2RPT(" ")
+19 QUIT
+20 ; BEGIN - PRCA*4.5*326
AUTOD(PAID,WHICH,RCGLB,RCTYPE) ; Display auto-decrease parameters - PRCA*4.5*345
+1 ; PRCA*4.5*349 - Added TRICARE
+2 ; Input: PAID - 1 - Claims with Payments parameters
+3 ; 0 - Claims with No Payments parameters
+4 ; RCGLB - Field value array from LIST^DIC call
+5 ; WHICH - 0 - Medical, 1 - Rx, 2 - TRICARE
+6 ; RCTYPE- Report type (M)edical, (P)harmacy, (T)RICARE or (A)ll
+7 ; RCPARM(344.61,0) - ^RCY(344.61,1,0)
+8 ; RCPARM(344.61,1) - ^RCY(344.61,1,1)
+9 ; Output: Auto-Decrease parameters are added to the report
+10 ;
+11 ; PRCA*4.5*349 - Add ONOFF variable to whether auto-post is enabled/disabled for this type
+12 NEW CNT,FIELD,ONOFF,RCCODE,RCI,X,XX,Y,YY
+13 ; Do not display Auto-Decrease questions when Auto-Post Disabled
+14 SET ONOFF=$$AUTOPON^RCDPESPC(WHICH)
+15 IF ONOFF=0
Begin DoDot:1
+16 NEW WNAME
+17 SET WNAME=$SELECT(WHICH=0:"Medical",WHICH=1:"Pharmacy",1:"TRICARE")
+18 DO AD2RPT("NOTICE: "_WNAME_" Auto-Decrease unavailable because Auto-Posting of "_WNAME_" Claims is currently disabled")
End DoDot:1
QUIT
+19 ; RCDPE PARAMETER file (#344.61), auto-decrease of medical claims
+20 IF WHICH=0
SET FIELD=$SELECT(PAID:.03,1:.11)
+21 IF '$TEST
IF WHICH=1
SET FIELD=1.02
+22 ; PRCA*4.5*349
IF '$TEST
SET FIELD=$SELECT(PAID:1.06,1:1.09)
+23 SET X=$$GET1^DID(344.61,FIELD,,"TITLE")
+24 ; remove yes/no prompt
IF X[" (Y/N): "
SET X=$PIECE(X," (Y/N): ")_": "
+25 SET Y=$JUSTIFY(X,45)_@RCGLB(344.61)@(344.61,"1,",FIELD,"E")
+26 DO AD2RPT(" ")
DO AD2RPT(Y)
+27 ; PRCA*4.5*349 - Added line
IF WHICH=0
SET XX=RCPARM("AUTO-POST")
SET YY=RCPARM("AUTO-DECREASE")
+28 ; PRCA*4.5*349 - Added line
IF WHICH=1
SET XX=RCPARM("RX AUTO-POST")
SET YY=RCPARM("RX AUTO-DECREASE")
+29 ; PRCA*4.5*349 - Added line
IF WHICH=2
SET XX=RCPARM("TRI AUTO-POST")
SET YY=RCPARM("TRI AUTO-DECREASE")
+30 ;
IF PAID
IF (XX!YY)
Begin DoDot:1
+31 ; PRCA*4.5*349
DO OPPAYS($SELECT(WHICH=0:"Medical",WHICH=1:"Pharmacy",1:"TRICARE")_" Auto-Decrease")
+32 DO AD2RPT(" ")
End DoDot:1
+33 ; If auto-decrease is off - do not display CARCS or auto-decrease days or auto-decrease maximum
+34 IF +$$GET1^DIQ(344.61,"1,",FIELD,"I")=0
QUIT
+35 ;
+36 ; PRCA*4.5*349 - Start modified block
+37 SET XX=$SELECT(WHICH=0:"MEDICAL",WHICH=1:"PHARMACY",1:"TRICARE")
+38 SET YY="MAXIMUM DOLLAR AMOUNT TO AUTO-DECREASE PER "_XX_" CLAIM: "_"$"
+39 SET XX=""
+40 ;
IF WHICH=0
Begin DoDot:1
+41 IF PAID
SET XX=YY_$$GET1^DIQ(344.61,"1,",.05,"E")
End DoDot:1
+42 IF WHICH=1
SET XX=YY_$$GET1^DIQ(344.61,"1,",1.04,"E")
+43 ;
IF WHICH=2
Begin DoDot:1
+44 IF PAID
SET XX=YY_$$GET1^DIQ(344.61,"1,",1.07,"E")
End DoDot:1
+45 IF XX'=""
DO AD2RPT(XX)
+46 ; PRCA*4.5*349 - End modified block
+47 ;
+48 SET CNT=0
+49 ; Print the CARC Auto-decrease parameters
+50 ; PRCA*4.5*349
IF $$CARCCHK(RCTYPE,PAID,$SELECT(WHICH=0:"M",WHICH=1:"P",1:"T"))
Begin DoDot:1
+51 DO AD2RPT(" ")
+52 SET X=" AUTO-DECREASE "_$SELECT(PAID:"PAID",1:"NO-PAY")
+53 SET X=X_" "_$SELECT(WHICH=0:"MEDICAL",WHICH=1:"PHARAMCY",1:"TRICARE")
+54 SET X=X_" CLAIMS FOR THE FOLLOWING CARC/AMOUNTS ONLY:"
+55 DO AD2RPT(X)
+56 DO AD2RPT(" ")
+57 SET RCSTRING=$TRANSLATE($JUSTIFY("",70)," ","-")
SET RCI=0
+58 DO AD2RPT(" CARC Description Max. Amt")
+59 DO AD2RPT(" "_RCSTRING)
+60 ;
+61 ; Loop and print entries
+62 ; PRCA*4.5*349 - Sort CARC entries by CARC code instead of by most recently entered
SET RCCODE=""
FOR
SET RCCODE=$ORDER(^RCY(344.62,"B",RCCODE))
if RCCODE=""
QUIT
Begin DoDot:2
+63 ; PRCA*4.5*349 - Sort CARC entries by CARC code instead of by most recently entered
SET RCI=0
FOR
SET RCI=$ORDER(^RCY(344.62,"B",RCCODE,RCI))
if 'RCI
QUIT
Begin DoDot:3
+64 SET RCCIEN=$ORDER(^RC(345,"B",RCCODE,""))
+65 ; WP field 345.04
SET RCDESC=$GET(^RC(345,RCCIEN,1,1,0))
+66 IF WHICH=0
SET FIELD=$SELECT(PAID:.02,1:.08)
+67 IF WHICH=1
SET FIELD=2.01
+68 IF WHICH=2
SET FIELD=$SELECT(PAID:3.01,1:3.07)
+69 SET RCSTAT=$$GET1^DIQ(344.62,RCI,FIELD,"I")
+70 if RCSTAT'=1
QUIT
+71 SET CNT=CNT+1
+72 IF $LENGTH(RCDESC)>50
SET RCDESC=$EXTRACT(RCDESC,1,50)_"..."
+73 DO GETCODES^RCDPCRR(RCCODE,"","A",$$DT^XLFDT,"RCCARCD","1^70")
+74 SET Y=" "_$JUSTIFY(RCCODE,4)_" "_$EXTRACT(RCDESC,1,53)
+75 if $LENGTH(RCDESC)<53
SET Y=Y_$JUSTIFY("",(53-$LENGTH(RCDESC)))
+76 IF WHICH=0
SET FIELD=$SELECT(PAID:.06,1:.12)
+77 IF WHICH=1
SET FIELD=2.05
+78 IF WHICH=2
SET FIELD=$SELECT(PAID:3.05,1:3.11)
+79 SET Y=Y_$JUSTIFY($$GET1^DIQ(344.62,RCI,FIELD,"I"),10,0)
+80 ; if inactive, display (i)
IF '$$ACT^RCDPRU(345,RCCODE,)
SET Y=Y_" (I)"
+81 DO AD2RPT(Y)
End DoDot:3
End DoDot:2
+82 IF CNT=0
DO AD2RPT(" No CARCs are set up for "_$SELECT(PAID:"",1:"NO-PAY ")_"auto-decrease")
End DoDot:1
+83 ;
+84 ; Display auto-decrease days
+85 IF WHICH=0
SET FIELD=$SELECT(PAID:.04,1:.12)
+86 IF WHICH=1
SET FIELD=1.03
+87 IF WHICH=2
SET FIELD=$SELECT(PAID:1.08,1:1.1)
+88 SET X=$PIECE($$GET1^DID(344.61,FIELD,,"TITLE")," (",1)_": "
+89 SET Y=$JUSTIFY(X,40)_@RCGLB(344.61)@(344.61,"1,",FIELD,"E")
+90 DO AD2RPT(" ")
DO AD2RPT(Y)
+91 QUIT
+92 ; END - PRCA*4.5*326
+93 ;
OPPAYS(RCTYPE) ; Output list of excluded payers - Added for PRCA*4.5*345
+1 ; Input: RCTYPE - Type of list being displayed. Free text.
+2 ; RCPARM - array assumed to exist and contain AUTO-POST and AUTO-DECREASE flags for MED or PHARM
+3 ; RCGLB - array assumed to exist and contain output from GETS^DIQ for payer exclusions
+4 ;
+5 NEW X,XX
+6 DO AD2RPT(" ")
+7 IF '$DATA(@RCGLB(344.6)@("DILIST",1,0))
Begin DoDot:1
+8 SET X=" No payers excluded from "_RCTYPE_"."
DO AD2RPT($JUSTIFY(" ",80-$LENGTH(X)\2)_X)
End DoDot:1
QUIT
+9 ;
+10 SET XX=$PIECE(RCTYPE," ",1)
+11 SET XX=$SELECT(XX="Pharmacy":"Rx",1:$EXTRACT(XX,1,3))
+12 SET XX=XX_" "_$PIECE(RCTYPE," ",2,3)
+13 SET X=" Excluded Payer ("_XX_")"_$JUSTIFY("",19-$LENGTH(XX))_"Comment"
+14 DO AD2RPT(X)
+15 SET RCNTR=0
FOR
SET RCNTR=$ORDER(@RCGLB(344.6)@("DILIST",RCNTR))
if 'RCNTR
QUIT
Begin DoDot:1
+16 SET V=@RCGLB(344.6)@("DILIST",RCNTR,0)
SET X=$EXTRACT($PIECE(V,U,2),1,35)
+17 SET Y=" "_X_$JUSTIFY(" ",36-$LENGTH(X))_$PIECE(V,U,5)
DO AD2RPT($EXTRACT(Y,1,IOM))
End DoDot:1
+18 QUIT
