RCDPESP ;BIRM/EWL - ePayment Lockbox Site Parameters Definition - Files 344.61 & 344.6 ; 6/3/19 1:59pm
;;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.
;
EN ; entry point for EDI Lockbox Parameters [RCDPE EDI LOCKBOX PARAMETERS]
N CATS,DA,DIC,DIE,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,X,Y ; FileMan variables
;
W !," Update AR Site Parameters",!
;
S X="RCDPE AUTO DEC"
I '$D(^XUSEC(X,DUZ)) D Q
. W !!,"You do not hold the "_X_" security key."
; Lock the parameter file
L +^RCY(344.61,1):DILOCKTM E D Q
. W !!," Another user is currently using the AR Site Parameters option."
. W !," Please try again later."
;
; PRCA*4.5*326 - Once lock is successful, take a snapshot of the parameters for monitoring
D EN^RCDPESP6
;
; Check parameter file
N FDAEDI,FDAPAYER,IEN,IENS,RCQUIT
; FDAPAYER - FDA array for RCDPE AUTO-PAY EXCLUSION file (#344.6)
; FDAEDI - FDA array for RCDPE PARAMETER file (#344.61)
; RCAUDVAL - audit data for RCDPE PARAMETER AUDIT file (#344.7)
; IEN - entry #
; IENS - IEN_comma
; RCQUIT - exit flag
;
; PRCA*4.5*349 - Added categories prompt
S CATS=$$CATS^RCDPESPC
I CATS="" D Q
. S RCQUIT=1
. D ABORT
S RCQUIT=0
I CATS'="AL" D ENCATS^RCDPESPC Q
; Call below answers:
; NUMBER OF DAYS EFT UNMATCHED
; NUMBER OF DAYS ERA UNMATCHED
; # OF DAYS ENTRY CAN REMAIN IN SUSP
; AUTO-DECREASE FIRST PARTY
; PRCA*4.5*349 - Added headings to old version of option
W !,"### EDI Lockbox Site & First Party Parameters ###",!
S Y=$$EDILOCK^RCMSITE ; Update EDI Lockbox site parameters
I 'Y D Q ; user entered '^'
. S RCQUIT=1
. D ABORT
;
; PRCA*4.5*304 - Enable/disable auto-auditing of paper bills
W !!,"### Auto-Audit Site Parameters ###"
S RCQUIT=$$AUDIT^RCDPESP5 ; Auto-Audit site parameters
I RCQUIT D ABORT Q ; PRCA*4.5*326 must have single exit point
;
I '$D(^RCY(344.61,1,0)) D Q ;
. W !!,"There is a problem with the RCDPE PARAMETER file (#344.61).",!
. D EXIT
;
W !!,"### Workload Notification Day Parameter ###"
S RCQUIT=$$BULLDAY ; Workload Notification Day parameter
I RCQUIT D ABORT Q
;
; Ask Medical Claims Auto-Post/Auto-Decrease questions
W !,"### Medical Claims Auto-Post/Auto-Decrease Parameters ###",!
S RCQUIT=$$MPARMS
I $G(RCQUIT) D ABORT Q
W !
;
; Ask Rx Auto-Post/Auto-Decrease questions
W !,"### Pharmacy Auto-Post/Auto-Decrease Parameters ###",!
S RCQUIT=$$RXPARMS
I $G(RCQUIT) D ABORT Q
W !
;
W !,"### TRICARE Auto-Post/Auto-Decrease Parameters ###",!
; PRCA*4.5*349 - Ask TRICARE Auto-Post/Auto-Decrease questions
S RCQUIT=$$TPARMS
I $G(RCQUIT) D ABORT Q
W !
;
W !,"### EFT Lock-Out Parameters ###",!
S RCQUIT=$$EFTLK ; Set EFT lock-out paramters
I $G(RCQUIT) D ABORT Q
D EXIT
Q
BULLDAY() ; Workload Notification Bulletin Days question
; (SELECT DAY TO SEND WORKLOAD NOTIFICATION)
; Returns: 1 - User '^' or timed out, 0 otherwise
; PRCA*4.5*321 - New parameter
N BULL,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDAEDI,RCAUDVAL,X,Y
;
S BULL=$$GET1^DIQ(344.61,"1,",.1,"I")
K DIR
S:BULL'="" DIR("B")=BULL
S DIR("?")=$$GET1^DID(344.61,.1,,"HELP-PROMPT")
S DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,.1,,"TITLE"))
S DIR(0)="344.61,.1"
W ! D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
I BULL'=Y D ; update and audit
. S RCAUDVAL(1)="344.61^.1^1^"_Y_U_BULL
. S FDAEDI(344.61,"1,",.1)=Y
. D FILE^DIE(,"FDAEDI")
. D AUDIT(.RCAUDVAL)
W !
Q 0
;
APOST(AUPSTYP,ONOFF) ; Turn Auto-Posting On/Off for Medical,RX,TRICARE Claims
; PRCA*4.5*345
; Input: AUPSTYP - 0 - Medical Auto-Posting
; 1 - Pharmacy Auto-Posting
; 2 - TRICARE Auto-Posting
; Output: ONOFF passed by ref. 1 - Auto-Posting of Medical/Pharmacy/TRICARE Claims with Payments on, 0 otherwise
; Returns: 1 - User '^' or timed out, 0 otherwise
N APCT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLD,FDAEDI,RCAUDVAL
S FLD=$S(AUPSTYP=0:.02,AUPSTYP=1:1.01,1:1.05) ; PRCA*4.5*349 - Add TRICARE
S APCT=$$GET1^DIQ(344.61,"1,",FLD,"I")
S DIR(0)="YA",DIR("B")=$S((APCT=1)!(APCT=""):"Yes",1:"No")
S DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
S DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
S ONOFF=Y
I APCT'=Y D ; User updated value
. S FDAEDI(344.61,"1,",FLD)=Y
. D FILE^DIE(,"FDAEDI")
. D NOTIFY(Y,AUPSTYP)
. S RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_APCT
. D AUDIT(.RCAUDVAL)
Q 0
;
; PRCA*4.5*349 - Refactored MPARMS to separate Auto-Post and Auto-Decrease questions
MPARMS() ; Medical Auto-Posting Questions
; Returns: 1 - User '^' or timed out, 0 otherwise
N RETURN,ONOFF
S RETURN=$$MAUTOP(.ONOFF)
Q:RETURN RETURN
Q:ONOFF=0 0
Q $$MAUTOD^RCDPESPC
;
; PRCA*4.5*349 - New function to ask only Medical Auto-Post questions
MAUTOP(ONOFF) ; Medical Claims Auto-Posting/Auto-Decrease questions
; Output: ONOFF passed by ref. 1 - Auto-Posting of Medical Claims with Payments on
; 0 - otherwise
; Returns: 1 - User '^' or timed out, 0 otherwise
N DIR,DIROUT,DIRUT,DTPIT,DUOUT,RCOLD,RCQUIT ; PRCA*4.5*349
S RCQUIT=$$APOST(0,.ONOFF) ; Auto-Posting of Med Claims parameter
Q:RCQUIT 1
Q:ONOFF=0 0 ; Medical Claim Auto-Posting turned off
;
D EXCLLIST(1) ; Display existing Payer exclusions for Med Auto-Post
Q:$$SETEXCL(1) 1 ; Set/Reset Payer Exclusions
D EXCLLIST(1) ; Display new Payer Exclusion list
Q 0
;
; PRCA*4.5*349 - Refactored RXPARMS to separate Auto-Post and Auto-Decrease questions
RXPARMS() ; Pharmacy Auto-Posting Questions
; Returns: 1 - User '^' or timed out, 0 otherwise
N RETURN,ONOFF
S RETURN=$$RXAUTOP(.ONOFF)
Q:RETURN RETURN
Q:ONOFF=0 0
Q $$RXAUTOD^RCDPESPC
;
; PRCA*4.5*349 - New function to ask only Pharmacy Auto-Post questions
RXAUTOP(ONOFF) ; Rx Claims Auto-Posting/Auto-Decrease questions
; Enable/disable auto-posting of pharmacy claims
; PRCA*4.5*349 - Subroutine re-written as was intended for PRCA*4.5*345
; Output: ONOFF passed by ref. 1 - Auto-Posting of Medical Claims with Payments on
; 0 - otherwise
; Returns: 1 - User '^' or timed out, 0 otherwise
N RETURN
Q:$$APOST(1,.ONOFF) 1 ; Auto-Posting of Rx Claims parameter
Q:ONOFF=0 0 ; Rx Auto-Posting turned off
D EXCLLIST(3) ; Display existing Payer exclusions for Rx Auto-Post
Q:$$SETEXCL(3) 1 ; Set/Reset Payer Exclusions
D EXCLLIST(3) ; Display the new Payer Exclusion list
W !
Q 0
;
ABORT ; Called when user enters a '^' or times out
; fall through to EXIT
;
EXIT ; Unlock, ask user to press return, exit
D EXIT^RCDPESP6 ; PRCA*4.5*326 - Send mail message if parameters have been edited.
L -^RCY(344.61,1)
D PAUSE
Q
;
; PRCA*4.5*349 - Refactored TPARMS to separate Auto-Post and Auto-Decrease questions
TPARMS() ; Pharmacy Auto-Posting Questions
; Returns: 1 - User '^' or timed out, 0 otherwise
N RETURN,ONOFF
S RETURN=$$TAUTOP(.ONOFF)
Q:RETURN RETURN
Q:ONOFF=0 0
Q $$TAUTOD^RCDPESPC
;
; PRCA*4.5*349 - New function to ask only TRICARE Auto-Post questions
TAUTOP(ONOFF) ; TRICARE Auto-Posting questions
; PRCA*4.5*349 - Added function
; Output: ONOFF passed by ref. 1 - Auto-Posting of Medical Claims with Payments on
; 0 - otherwise
; Returns: 1 - User '^' or timed out, 0 otherwise
N RCQUIT,RETURN
S RCQUIT=$$APOST(2,.ONOFF) ; Auto-Posting of TRICARE Claims parameter
I RCQUIT Q 1
Q:ONOFF=0 0 ; TRICARE Claim Auto-Posting turned off
D EXCLLIST(5) ; Display existing Payer exclusions for TRICARE Auto-Post
Q:$$SETEXCL(5) 1 ; Set/Reset Payer Exclusions
D EXCLLIST(5) ; Display the new Payer Exclusion list
Q 0
;
EFTLK() ; Set EFT lock-out parameters, PRCA*4.5*345
; Returns: 1 - User '^' or timed out
; 0 otherwise
Q:$$EFTLKPRM(.06) 1 ; (#.06) MEDICAL EFT POST PREVENT DAYS [6N]
Q:$$EFTLKPRM(.07) 1 ; (#.07) PHARMACY EFT POST PREVENT DAYS [7N]
Q:$$EFTLKPRM(.13) 1 ; (#.13) TRICARE EFT POST PREVENT DAYS [13N]
Q 0
;
EFTLKPRM(FLD) ; Ask a Medical/Rx EFT lock-out question, PRCA*4.5*345
; NUMBER OF DAYS (AGE) OF UNPOSTED xxx EFTS TO PREVENT POSTING
; Input: FLD - Field # of question being asked
; Returns: 1 - User '^' or timed out
; 0 otherwise
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCVAL,X,Y
S RCVAL=$$GET1^DIQ(344.61,"1,",FLD)
S:RCVAL'="" DIR("B")=RCVAL,DA=1 ; default value and IEN
S DIR(0)="344.61,"_FLD_"A",DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q 1
I RCVAL'=Y D ; Update and audit
. N AUDVAL
. S RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_RCVAL
. S FDAEDI(344.61,"1,",FLD)=Y D FILE^DIE(,"FDAEDI")
. D AUDIT(.RCAUDVAL)
Q 0
;
PAUSE ; prompt user to press return
W ! N DIR
S DIR("T")=3,DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR
Q
;
COUNT(ACTVCARC,PDCLM,CLMTYP) ;Count active CARCs in file 344.62 (RCDPE CARC-RARC AUTO DEC)
; PRCA*4.5*345 - Added PDCLM,CLMTYP
; Input: ACTVCARC: 0 - Count inactive CARCs, 1 - Count active CARCs
; PDCLM: 0 - Paid Claims, 1 - No-Pay Claims
; CLMTYP: - 0 - Medical, 1 - pharm, 2 - TRICARE
; Returns: 0 - Invalid parameter, otherwise the number of active CARCs are returned
N I,NUM,XREF ; PRCA&4.5*345 - Added XREF
I (ACTVCARC'=0),(ACTVCARC'=1) Q 0 ; If ACTVCARC is not active (1) or inactive (0) quit with zero
S XREF=""
I 'PDCLM,'CLMTYP S XREF="ACTV" ; (#.02) CARC AUTO DECREASE [2S]
I XREF="",'PDCLM,CLMTYP=1 S XREF="ACTVR" ; (#2.01) CARC PHARM AUTO DECREASE
I XREF="",'PDCLM,CLMTYP=2 S XREF="ACTVT" ; PRCA*4.5*349 (#3.01) CARC TRICARE W PYMNTS AUTO-DEC [1S]
I XREF="",PDCLM,CLMTYP=0 S XREF="ACTVN" ; (#.08) CARC AUTO DECREASE NO-PAY [1S]
I XREF="",PDCLM,CLMTYP=2 S XREF="ACTVNT" ; PRCA*4.5*349 (#3.07) CARC TRICARE AUTO-DECRS NO-PAY [7S]
;
I XREF="" Q 0 ; need a cross-reference, return zero
; count entries on the cross-ref.
S NUM=0,I="" F S I=$O(^RCY(344.62,XREF,ACTVCARC,I)) Q:I="" S NUM=NUM+1
Q NUM
;
EXCLLIST(TYP) ; Display Payer Exclusion lists for Auto-Post and Auto-Decrease
; for Medical, Pharmacy and TRICARE
; PRCA*4.5*349 - Added Rx/TRICRE options
; Input: TYP - 1 - Medical Auto-Post payer exclusions
; 2 - Medical Auto-Decrease payer exclusions
; 3 - Rx Auto-Post payer exclusions
; 4 - Rx Auto-Decrease payer exclusions
; 5 - TRICARE Auto-Post payer exclusions
; 6 - TRICRE Auto-Decrease payer exclusions
;
Q:'("^1^2^3^4^5^6^"[(U_$G(TYP)_U)) ; PRCA*4.5*349 - TYP must be valid
N CT,EXCHDR,IEN,IX,LIST
S (IEN,CT)=0
W !
; Determine which index to used
; PRCA*4.5*345 Start modified code block - added Rx/TRICARE options
I TYP=1 D
. S IX="EXMDPOST"
. S LIST="Payers excluded from Medical Auto-Posting:"
E I TYP=2 D
. S IX="EXMDDECR"
. S LIST="Additional Payers excluded from Medical Auto-Decrease:"
E I TYP=3 D
. S IX="EXRXPOST"
. S LIST="Payers excluded from Pharmacy Auto-Posting:"
E I TYP=4 D
. S IX="EXRXDECR"
. S LIST="Additional Payers excluded from Pharmacy Auto-Decrease:"
; PRCA*4.5*349 - Add TRICARE
E I TYP=5 D
. S IX="EXTRPOST"
. S LIST="Additional Payers excluded from TRICARE Auto-Posting:"
E D
. S IX="EXTRDECR"
. S LIST="Additional Payers excluded from TRICARE Auto-Decrease:"
;
; if list is for auto-decrease and there are exclusions write a message
S (IEN,CT)=0
F D Q:'IEN
. S IEN=$O(^RCY(344.6,IX,1,IEN))
. Q:'IEN
. S CT=CT+1
. W:CT=1 !,LIST
. W !," "_$P(^RCY(344.6,IEN,0),U,1)_" "_$P(^RCY(344.6,IEN,0),U,2)
;
I TYP=2!(TYP=4)!(TYP=6) D
. W !,"All payers excluded from Auto-Posting are also excluded from Auto-Decrease."
;
I CT=0 W !," No "_LIST
; PRCA*4.5*349 - End modified code block
Q
;
SETEXCL(TYP) ; LOOP FOR SETTING PAYER EXCLUSIONS for Medical, Rx and TRICARE and Auto-Decrease payer exclusions
; PRCA*4.5*349 - Added Rx/TRICARE sets
; Input: TYP - 1 - Set Medical Auto-Post payer exclusions
; 2 - Set Medical Auto-Decrease payer exclusions
; 3 - Set Rx Auto-Post payer exclusions
; 4 - Set Rxl Auto-Decrease payer exclusions
; 5 - Set TRICARE Auto-Post payer exclusions
; 6 - Set TRICARE Auto-Decrease payer exclusions
; Returns: 1 - User '^' or timed out
; 0 otherwise
;
N CMT,CT,DIC,DIR,DONE,FDAPAYER,FLD,IEN,PREC,RCAUDVAL,RCQUIT,RTYP,X,XX,Y
; PRCA*4.5*349 - Added Rx/TRICARE claims decrease
I $G(TYP)=1 S FLD=.06,CMT=1,RTYP="MEDICAL CLAIMS POSTING"
E I $G(TYP)=2 S FLD=.07,CMT=2,RTYP="MEDICAL CLAIMS DECREASE"
E I $G(TYP)=3 S FLD=.08,CMT=3,RTYP="PHARMACY CLAIMS POSTING"
E I $G(TYP)=4 S FLD=.12,CMT=4,RTYP="PHARMACY CLAIMS DECREASE"
E I $G(TYP)=5 S FLD=.13,CMT=5,RTYP="TRICARE CLAIMS POSTING"
E S FLD=.14,CMT=6,RTYP="TRICARE CLAIMS DECREASE"
;
W !!,"Select a Payer to add or remove from the exclusion list.",!
S (RCQUIT,CT,DONE)=0
F Q:DONE!RCQUIT D
. S DIC="^RCY(344.6,",DIC(0)="AEMQZ",DIC("A")="Payer: "
. S DIC("S")="I $$PAYTYP^RCDPESPB("_TYP_","_FLD_")" ; PRCA*4.5*349
. D ^DIC
. I X="^" S RCQUIT=1 Q
. I +$G(Y)<1 S DONE=1 Q
. S CT=CT+1,IEN=+Y,PREC=Y(0)
. K FDAPAYER
. N COMMENT,STAT
. S COMMENT="",STAT='$$GET1^DIQ(344.6,IEN_",",FLD,"I")
. S FDAPAYER(344.6,IEN_",",FLD)=STAT
. ; GET COMMENT HERE
. K Y S DIR("A")="COMMENT: ",DIR(0)="FA^3:72"
. S DIR("PRE")="S X=$$TRIM^XLFSTR(X,""LR"")" ; comment required and should be significant
. S DIR("?")="Enter an explanation for "_$S(STAT:"adding the payer to",1:"removing the payer from")_" the list of Excluded Payers."
. S XX="Enter an explanation for "
. S XX=XX_$S(STAT:"adding the payer to",1:"removing the payer from")
. S DIR("?")=XX_" the list of Excluded Payers."
. D ^DIR
. I $D(DTOUT)!$D(DUOUT) S RCQUIT=1 Q
. I Y="" S DONE=1 Q ; stop loop
. S COMMENT=Y
. I COMMENT'="" D
. . S FDAPAYER(344.6,IEN_",",CMT)=$S(STAT:COMMENT,1:"")
. . W !,$P(PREC,U)_" "_$P(PREC,U,2)_" has been "_$S(STAT:"added to",1:"removed from")_" the list of Excluded Payers"
. . I TYP=1 D
. . . W !,"If Medical Auto-Decrease is turned on, "
. . . I STAT W "this payer will be excluded from Medical Auto-Decrease too."
. . . I 'STAT,'$$GET1^DIQ(344.6,IEN_",",.07,"I") W "this payer will no longer be excluded from Medical Auto-Decrease."
. . . I 'STAT,$$GET1^DIQ(344.6,IEN_",",.07,"I") W "Medical Auto-Decrease is set to be excluded for this payer."
. . ;
. . ; PRCA*4.5*349 - Added if below
. . I TYP=3 D
. . . W !,"If pharmacy auto-decrease is turned on, "
. . . I STAT W "this payer will be excluded from Pharmacy auto-decrease too."
. . . I 'STAT,'$$GET1^DIQ(344.6,IEN_",",.12,"I") D
. . . . W "this payer will no longer be excluded from Pharmacy Auto-Decrease."
. . . I 'STAT,$$GET1^DIQ(344.6,IEN_",",.12,"I") D
. . . . W "Pharmacy Auto-Decrease is set to be excluded for this payer."
. . ;
. . ; PRCA*4.5*349 - Added if below
. . I TYP=5 D
. . . W !,"If TRICARE auto-decrease is turned on, "
. . . I STAT W "this payer will be excluded from TRICARE Auto-Decrease too."
. . . I 'STAT,'$$GET1^DIQ(344.6,IEN_",",.14,"I") D
. . . . W "this payer will no longer be excluded from TRICARE Auto-Decrease."
. . . I 'STAT,$$GET1^DIQ(344.6,IEN_",",.14,"I") D
. . . . W "TRICARE Auto-Decrease is set to be excluded for this payer."
. . K RCAUDVAL
. . D FILE^DIE(,"FDAPAYER")
. . S RCAUDVAL(1)="344.6"_U_FLD_U_IEN_U_STAT_U_('STAT)_U_COMMENT
. . D AUDIT(.RCAUDVAL)
;
Q RCQUIT
;
NOTIFY(VAL,TYPE) ; Notification of change to Site Parameters
N C,G,GLB,MSG,SITE,SUBJ,XMINSTR,XMTO
S SITE=$$SITE^VASITE
S TYPE=$G(TYPE) ; optional parameter
; limit subject to 65 chars.
S SUBJ=$E("Site Parameter edit, Station #"_$P(SITE,U,3)_" - "_$P(SITE,U,2),1,65)
D XMSGBODY^RCDPESPB(.MSG) ; body of message
S C=MSG ; line count
S C=C+1
S MSG(C)=" ENABLE AUTO-POSTING OF "_$S(TYPE=1:"PHARMACY",TYPE=2:"TRICARE",1:"MEDICAL")_" CLAIMS = "
S MSG(C)=MSG(C)_$$FRMT^RCDPESP6(VAL,"B")
S C=C+1,MSG(C)=" "
;send message to mail group
S XMTO(DUZ)="",XMTO("G.RCDPE AUDIT")=""
K ^TMP("XMERR",$J)
D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
I $D(^TMP("XMERR",$J)) D
. D MES^XPDUTL("MailMan reported a problem trying to send the notification message.")
. D MES^XPDUTL("MailMan error text:")
. S (G,GLB)=$NA(^TMP("XMERR",$J))
. F S G=$Q(@G) Q:G'[GLB D MES^XPDUTL(" "_@G)
. D MES^XPDUTL("* End of MailMan Error *")
Q
;
AUDIT(INP) ; WRITE AUDIT RECORD(S)
; INP = audit value in this format:
; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE^COMMENT
Q:'$O(INP(0)) ; nothing to audit
N RCI,RCNOW
S RCNOW=$$NOW^XLFDT
S RCI=0 F S RCI=$O(INP(RCI)) Q:'RCI D
. N FDAUDT,X S X=INP(RCI)
. S FDAUDT(344.7,"+1,",.01)=RCNOW ;TIMESTAMP [1D]
. S FDAUDT(344.7,"+1,",.02)=$P(X,U,3) ;MODIFIED IEN [2N]
. S FDAUDT(344.7,"+1,",.03)=DUZ ;CHANGED BY [3P:200]
. S FDAUDT(344.7,"+1,",.04)=$P(X,U,2) ;CHANGED FIELD [4N]
. S FDAUDT(344.7,"+1,",.05)=$P(X,U) ;MODIFIED FILE [5S]
. S FDAUDT(344.7,"+1,",.06)=$P(X,U,4) ;NEW VALUE [6F]
. S FDAUDT(344.7,"+1,",.07)=$P(X,U,5) ;OLD VALUE [7F]
. S FDAUDT(344.7,"+1,",.08)=$P(X,U,6) ;COMMENT [8F]
. D UPDATE^DIE(,"FDAUDT")
Q
;
; CALLS RELATED TO CREATING EPAYMENT PAYER EXCLUSION PARAMETERS
;
NEWPYR ;Add new payers to payer table - called from AR Nightly Job (EN^RCDPEM)
; PRCA*4.5*326 - Add payers that are just on EFTs to file 344.6
N RCDATE,RCFDA,RCEFT,RCERA,RCUPD,RCXD
;Get date/time of last run otherwise start at previous day
S RCDATE=$P($G(^RCY(344.61,1,0)),U,8) S:RCDATE="" RCDATE=$$FMADD^XLFDT($$NOW^XLFDT\1,-1)
S RCXD=RCDATE
F S RCXD=$O(^RCY(344.4,"AFD",RCXD)) Q:'RCXD D
. S RCERA="" F S RCERA=$O(^RCY(344.4,"AFD",RCXD,RCERA)) Q:'RCERA D ;
. . S RCUPD=$$PAYRINIT(RCERA,344.4)
;
S RCXD=$$FMADD^XLFDT($P(RCDATE,".",1),-1)
F S RCXD=$O(^RCY(344.31,"ADR",RCXD)) Q:'RCXD D
. S RCEFT="" F S RCEFT=$O(^RCY(344.31,"ADR",RCXD,RCEFT)) Q:'RCEFT D ;
. . S RCUPD=$$PAYRINIT(RCEFT,344.31)
;
;Update last run date
S RCFDA(344.61,"1,",.08)=$$NOW^XLFDT()
D FILE^DIE("","RCFDA")
; PRCA*4.5*326 - End modified block
Q
;
PAYERPRM(IEN,EXMDPOST,EXMDDECR) ; update new payer
Q:'$G(IEN)!('$D(^RCY(344.4,+$G(IEN),0))) 0 ; IEN valid?
N ID,PAYER,PFDA,PIENS
S PAYER=$E($$GET1^DIQ(344.4,IEN_",",.06),1,35)
Q:PAYER="" 0
S ID=$E($$GET1^DIQ(344.4,IEN_",",.03),1,30)
I '$D(^RCY(344.6,"CPID",PAYER,ID)) Q 0
; FILE CURRENT SETTINGS
S PIENS=$O(^RCY(344.6,"CPID",PAYER,ID,0))_","
S PFDA(344.6,PIENS,.04)=DUZ
S PFDA(344.6,PIENS,.05)=$$NOW^XLFDT
S PFDA(344.6,PIENS,.06)=+$G(EXMDPOST)
S PFDA(344.6,PIENS,.07)=+$G(EXMDDECR)
D FILE^DIE(,"PFDA")
Q 1
;
PAYRINIT(IEN,FILE) ; Add Payer Name and Payer ID to Payer table #344.6
;
N PFDA,PAYER,ID,PIENS,ERADATE,RCFLD
;
Q:'$G(IEN)!('$D(^RCY(FILE,+$G(IEN)))) 0
; PRCA*4.5*326 - Add payers from EFTs
S RCFLD("NAME")=$S(FILE=344.4:.06,1:.02)
S RCFLD("ID")=.03
S RCFLD("DATE")=$S(FILE=344.4:.07,1:.13)
;
S PAYER=$$GET1^DIQ(FILE,IEN_",",RCFLD("NAME")) Q:PAYER="" 0
S ID=$$GET1^DIQ(FILE,IEN_",",RCFLD("ID")) Q:ID="" 0
I $D(^RCY(344.6,"CPID",PAYER,ID)) Q 1
S ERADATE=$$GET1^DIQ(FILE,IEN_",",RCFLD("DATE"),"I")
; PRCA*4.5*326 - End modified block
;
; UPDATE PAYER PARAMETERS
S PIENS="+1,"
S PFDA(344.6,PIENS,.01)=PAYER
S PFDA(344.6,PIENS,.02)=ID
S PFDA(344.6,PIENS,.03)=ERADATE
S PFDA(344.6,PIENS,.04)=.5
S PFDA(344.6,PIENS,.05)=$$NOW^XLFDT
S PFDA(344.6,PIENS,.06)=0
S PFDA(344.6,PIENS,.07)=0
I FILE=344.31 S PFDA(344.6,PIENS,.11)=1 ; PRCA*4.5*326
D UPDATE^DIE(,"PFDA")
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESP 19878 printed Apr 09, 2024@20:49:47 Page 2
RCDPESP ;BIRM/EWL - ePayment Lockbox Site Parameters Definition - Files 344.61 & 344.6 ; 6/3/19 1:59pm
+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 ;
EN ; entry point for EDI Lockbox Parameters [RCDPE EDI LOCKBOX PARAMETERS]
+1 ; FileMan variables
NEW CATS,DA,DIC,DIE,DIR,DIRUT,DLAYGO,DR,DTOUT,DUOUT,X,Y
+2 ;
+3 WRITE !," Update AR Site Parameters",!
+4 ;
+5 SET X="RCDPE AUTO DEC"
+6 IF '$DATA(^XUSEC(X,DUZ))
Begin DoDot:1
+7 WRITE !!,"You do not hold the "_X_" security key."
End DoDot:1
QUIT
+8 ; Lock the parameter file
+9 LOCK +^RCY(344.61,1):DILOCKTM
IF '$TEST
Begin DoDot:1
+10 WRITE !!," Another user is currently using the AR Site Parameters option."
+11 WRITE !," Please try again later."
End DoDot:1
QUIT
+12 ;
+13 ; PRCA*4.5*326 - Once lock is successful, take a snapshot of the parameters for monitoring
+14 DO EN^RCDPESP6
+15 ;
+16 ; Check parameter file
+17 NEW FDAEDI,FDAPAYER,IEN,IENS,RCQUIT
+18 ; FDAPAYER - FDA array for RCDPE AUTO-PAY EXCLUSION file (#344.6)
+19 ; FDAEDI - FDA array for RCDPE PARAMETER file (#344.61)
+20 ; RCAUDVAL - audit data for RCDPE PARAMETER AUDIT file (#344.7)
+21 ; IEN - entry #
+22 ; IENS - IEN_comma
+23 ; RCQUIT - exit flag
+24 ;
+25 ; PRCA*4.5*349 - Added categories prompt
+26 SET CATS=$$CATS^RCDPESPC
+27 IF CATS=""
Begin DoDot:1
+28 SET RCQUIT=1
+29 DO ABORT
End DoDot:1
QUIT
+30 SET RCQUIT=0
+31 IF CATS'="AL"
DO ENCATS^RCDPESPC
QUIT
+32 ; Call below answers:
+33 ; NUMBER OF DAYS EFT UNMATCHED
+34 ; NUMBER OF DAYS ERA UNMATCHED
+35 ; # OF DAYS ENTRY CAN REMAIN IN SUSP
+36 ; AUTO-DECREASE FIRST PARTY
+37 ; PRCA*4.5*349 - Added headings to old version of option
+38 WRITE !,"### EDI Lockbox Site & First Party Parameters ###",!
+39 ; Update EDI Lockbox site parameters
SET Y=$$EDILOCK^RCMSITE
+40 ; user entered '^'
IF 'Y
Begin DoDot:1
+41 SET RCQUIT=1
+42 DO ABORT
End DoDot:1
QUIT
+43 ;
+44 ; PRCA*4.5*304 - Enable/disable auto-auditing of paper bills
+45 WRITE !!,"### Auto-Audit Site Parameters ###"
+46 ; Auto-Audit site parameters
SET RCQUIT=$$AUDIT^RCDPESP5
+47 ; PRCA*4.5*326 must have single exit point
IF RCQUIT
DO ABORT
QUIT
+48 ;
+49 ;
IF '$DATA(^RCY(344.61,1,0))
Begin DoDot:1
+50 WRITE !!,"There is a problem with the RCDPE PARAMETER file (#344.61).",!
+51 DO EXIT
End DoDot:1
QUIT
+52 ;
+53 WRITE !!,"### Workload Notification Day Parameter ###"
+54 ; Workload Notification Day parameter
SET RCQUIT=$$BULLDAY
+55 IF RCQUIT
DO ABORT
QUIT
+56 ;
+57 ; Ask Medical Claims Auto-Post/Auto-Decrease questions
+58 WRITE !,"### Medical Claims Auto-Post/Auto-Decrease Parameters ###",!
+59 SET RCQUIT=$$MPARMS
+60 IF $GET(RCQUIT)
DO ABORT
QUIT
+61 WRITE !
+62 ;
+63 ; Ask Rx Auto-Post/Auto-Decrease questions
+64 WRITE !,"### Pharmacy Auto-Post/Auto-Decrease Parameters ###",!
+65 SET RCQUIT=$$RXPARMS
+66 IF $GET(RCQUIT)
DO ABORT
QUIT
+67 WRITE !
+68 ;
+69 WRITE !,"### TRICARE Auto-Post/Auto-Decrease Parameters ###",!
+70 ; PRCA*4.5*349 - Ask TRICARE Auto-Post/Auto-Decrease questions
+71 SET RCQUIT=$$TPARMS
+72 IF $GET(RCQUIT)
DO ABORT
QUIT
+73 WRITE !
+74 ;
+75 WRITE !,"### EFT Lock-Out Parameters ###",!
+76 ; Set EFT lock-out paramters
SET RCQUIT=$$EFTLK
+77 IF $GET(RCQUIT)
DO ABORT
QUIT
+78 DO EXIT
+79 QUIT
BULLDAY() ; Workload Notification Bulletin Days question
+1 ; (SELECT DAY TO SEND WORKLOAD NOTIFICATION)
+2 ; Returns: 1 - User '^' or timed out, 0 otherwise
+3 ; PRCA*4.5*321 - New parameter
+4 NEW BULL,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FDAEDI,RCAUDVAL,X,Y
+5 ;
+6 SET BULL=$$GET1^DIQ(344.61,"1,",.1,"I")
+7 KILL DIR
+8 if BULL'=""
SET DIR("B")=BULL
+9 SET DIR("?")=$$GET1^DID(344.61,.1,,"HELP-PROMPT")
+10 SET DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,.1,,"TITLE"))
+11 SET DIR(0)="344.61,.1"
+12 WRITE !
DO ^DIR
+13 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+14 ; update and audit
IF BULL'=Y
Begin DoDot:1
+15 SET RCAUDVAL(1)="344.61^.1^1^"_Y_U_BULL
+16 SET FDAEDI(344.61,"1,",.1)=Y
+17 DO FILE^DIE(,"FDAEDI")
+18 DO AUDIT(.RCAUDVAL)
End DoDot:1
+19 WRITE !
+20 QUIT 0
+21 ;
APOST(AUPSTYP,ONOFF) ; Turn Auto-Posting On/Off for Medical,RX,TRICARE Claims
+1 ; PRCA*4.5*345
+2 ; Input: AUPSTYP - 0 - Medical Auto-Posting
+3 ; 1 - Pharmacy Auto-Posting
+4 ; 2 - TRICARE Auto-Posting
+5 ; Output: ONOFF passed by ref. 1 - Auto-Posting of Medical/Pharmacy/TRICARE Claims with Payments on, 0 otherwise
+6 ; Returns: 1 - User '^' or timed out, 0 otherwise
+7 NEW APCT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLD,FDAEDI,RCAUDVAL
+8 ; PRCA*4.5*349 - Add TRICARE
SET FLD=$SELECT(AUPSTYP=0:.02,AUPSTYP=1:1.01,1:1.05)
+9 SET APCT=$$GET1^DIQ(344.61,"1,",FLD,"I")
+10 SET DIR(0)="YA"
SET DIR("B")=$SELECT((APCT=1)!(APCT=""):"Yes",1:"No")
+11 SET DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
+12 SET DIR("?")=$$GET1^DID(344.61,FLD,,"HELP-PROMPT")
+13 DO ^DIR
+14 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+15 SET ONOFF=Y
+16 ; User updated value
IF APCT'=Y
Begin DoDot:1
+17 SET FDAEDI(344.61,"1,",FLD)=Y
+18 DO FILE^DIE(,"FDAEDI")
+19 DO NOTIFY(Y,AUPSTYP)
+20 SET RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_APCT
+21 DO AUDIT(.RCAUDVAL)
End DoDot:1
+22 QUIT 0
+23 ;
+24 ; PRCA*4.5*349 - Refactored MPARMS to separate Auto-Post and Auto-Decrease questions
MPARMS() ; Medical Auto-Posting Questions
+1 ; Returns: 1 - User '^' or timed out, 0 otherwise
+2 NEW RETURN,ONOFF
+3 SET RETURN=$$MAUTOP(.ONOFF)
+4 if RETURN
QUIT RETURN
+5 if ONOFF=0
QUIT 0
+6 QUIT $$MAUTOD^RCDPESPC
+7 ;
+8 ; PRCA*4.5*349 - New function to ask only Medical Auto-Post questions
MAUTOP(ONOFF) ; Medical Claims Auto-Posting/Auto-Decrease questions
+1 ; Output: ONOFF passed by ref. 1 - Auto-Posting of Medical Claims with Payments on
+2 ; 0 - otherwise
+3 ; Returns: 1 - User '^' or timed out, 0 otherwise
+4 ; PRCA*4.5*349
NEW DIR,DIROUT,DIRUT,DTPIT,DUOUT,RCOLD,RCQUIT
+5 ; Auto-Posting of Med Claims parameter
SET RCQUIT=$$APOST(0,.ONOFF)
+6 if RCQUIT
QUIT 1
+7 ; Medical Claim Auto-Posting turned off
if ONOFF=0
QUIT 0
+8 ;
+9 ; Display existing Payer exclusions for Med Auto-Post
DO EXCLLIST(1)
+10 ; Set/Reset Payer Exclusions
if $$SETEXCL(1)
QUIT 1
+11 ; Display new Payer Exclusion list
DO EXCLLIST(1)
+12 QUIT 0
+13 ;
+14 ; PRCA*4.5*349 - Refactored RXPARMS to separate Auto-Post and Auto-Decrease questions
RXPARMS() ; Pharmacy Auto-Posting Questions
+1 ; Returns: 1 - User '^' or timed out, 0 otherwise
+2 NEW RETURN,ONOFF
+3 SET RETURN=$$RXAUTOP(.ONOFF)
+4 if RETURN
QUIT RETURN
+5 if ONOFF=0
QUIT 0
+6 QUIT $$RXAUTOD^RCDPESPC
+7 ;
+8 ; PRCA*4.5*349 - New function to ask only Pharmacy Auto-Post questions
RXAUTOP(ONOFF) ; Rx Claims Auto-Posting/Auto-Decrease questions
+1 ; Enable/disable auto-posting of pharmacy claims
+2 ; PRCA*4.5*349 - Subroutine re-written as was intended for PRCA*4.5*345
+3 ; Output: ONOFF passed by ref. 1 - Auto-Posting of Medical Claims with Payments on
+4 ; 0 - otherwise
+5 ; Returns: 1 - User '^' or timed out, 0 otherwise
+6 NEW RETURN
+7 ; Auto-Posting of Rx Claims parameter
if $$APOST(1,.ONOFF)
QUIT 1
+8 ; Rx Auto-Posting turned off
if ONOFF=0
QUIT 0
+9 ; Display existing Payer exclusions for Rx Auto-Post
DO EXCLLIST(3)
+10 ; Set/Reset Payer Exclusions
if $$SETEXCL(3)
QUIT 1
+11 ; Display the new Payer Exclusion list
DO EXCLLIST(3)
+12 WRITE !
+13 QUIT 0
+14 ;
ABORT ; Called when user enters a '^' or times out
+1 ; fall through to EXIT
+2 ;
EXIT ; Unlock, ask user to press return, exit
+1 ; PRCA*4.5*326 - Send mail message if parameters have been edited.
DO EXIT^RCDPESP6
+2 LOCK -^RCY(344.61,1)
+3 DO PAUSE
+4 QUIT
+5 ;
+6 ; PRCA*4.5*349 - Refactored TPARMS to separate Auto-Post and Auto-Decrease questions
TPARMS() ; Pharmacy Auto-Posting Questions
+1 ; Returns: 1 - User '^' or timed out, 0 otherwise
+2 NEW RETURN,ONOFF
+3 SET RETURN=$$TAUTOP(.ONOFF)
+4 if RETURN
QUIT RETURN
+5 if ONOFF=0
QUIT 0
+6 QUIT $$TAUTOD^RCDPESPC
+7 ;
+8 ; PRCA*4.5*349 - New function to ask only TRICARE Auto-Post questions
TAUTOP(ONOFF) ; TRICARE Auto-Posting questions
+1 ; PRCA*4.5*349 - Added function
+2 ; Output: ONOFF passed by ref. 1 - Auto-Posting of Medical Claims with Payments on
+3 ; 0 - otherwise
+4 ; Returns: 1 - User '^' or timed out, 0 otherwise
+5 NEW RCQUIT,RETURN
+6 ; Auto-Posting of TRICARE Claims parameter
SET RCQUIT=$$APOST(2,.ONOFF)
+7 IF RCQUIT
QUIT 1
+8 ; TRICARE Claim Auto-Posting turned off
if ONOFF=0
QUIT 0
+9 ; Display existing Payer exclusions for TRICARE Auto-Post
DO EXCLLIST(5)
+10 ; Set/Reset Payer Exclusions
if $$SETEXCL(5)
QUIT 1
+11 ; Display the new Payer Exclusion list
DO EXCLLIST(5)
+12 QUIT 0
+13 ;
EFTLK() ; Set EFT lock-out parameters, PRCA*4.5*345
+1 ; Returns: 1 - User '^' or timed out
+2 ; 0 otherwise
+3 ; (#.06) MEDICAL EFT POST PREVENT DAYS [6N]
if $$EFTLKPRM(.06)
QUIT 1
+4 ; (#.07) PHARMACY EFT POST PREVENT DAYS [7N]
if $$EFTLKPRM(.07)
QUIT 1
+5 ; (#.13) TRICARE EFT POST PREVENT DAYS [13N]
if $$EFTLKPRM(.13)
QUIT 1
+6 QUIT 0
+7 ;
EFTLKPRM(FLD) ; Ask a Medical/Rx EFT lock-out question, PRCA*4.5*345
+1 ; NUMBER OF DAYS (AGE) OF UNPOSTED xxx EFTS TO PREVENT POSTING
+2 ; Input: FLD - Field # of question being asked
+3 ; Returns: 1 - User '^' or timed out
+4 ; 0 otherwise
+5 NEW DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,RCVAL,X,Y
+6 SET RCVAL=$$GET1^DIQ(344.61,"1,",FLD)
+7 ; default value and IEN
if RCVAL'=""
SET DIR("B")=RCVAL
SET DA=1
+8 SET DIR(0)="344.61,"_FLD_"A"
SET DIR("A")=$$PADPRMPT^RCDPESPB($$GET1^DID(344.61,FLD,,"TITLE"))
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT 1
+11 ; Update and audit
IF RCVAL'=Y
Begin DoDot:1
+12 NEW AUDVAL
+13 SET RCAUDVAL(1)="344.61^"_FLD_"^1^"_Y_U_RCVAL
+14 SET FDAEDI(344.61,"1,",FLD)=Y
DO FILE^DIE(,"FDAEDI")
+15 DO AUDIT(.RCAUDVAL)
End DoDot:1
+16 QUIT 0
+17 ;
PAUSE ; prompt user to press return
+1 WRITE !
NEW DIR
+2 SET DIR("T")=3
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
+3 QUIT
+4 ;
COUNT(ACTVCARC,PDCLM,CLMTYP) ;Count active CARCs in file 344.62 (RCDPE CARC-RARC AUTO DEC)
+1 ; PRCA*4.5*345 - Added PDCLM,CLMTYP
+2 ; Input: ACTVCARC: 0 - Count inactive CARCs, 1 - Count active CARCs
+3 ; PDCLM: 0 - Paid Claims, 1 - No-Pay Claims
+4 ; CLMTYP: - 0 - Medical, 1 - pharm, 2 - TRICARE
+5 ; Returns: 0 - Invalid parameter, otherwise the number of active CARCs are returned
+6 ; PRCA&4.5*345 - Added XREF
NEW I,NUM,XREF
+7 ; If ACTVCARC is not active (1) or inactive (0) quit with zero
IF (ACTVCARC'=0)
IF (ACTVCARC'=1)
QUIT 0
+8 SET XREF=""
+9 ; (#.02) CARC AUTO DECREASE [2S]
IF 'PDCLM
IF 'CLMTYP
SET XREF="ACTV"
+10 ; (#2.01) CARC PHARM AUTO DECREASE
IF XREF=""
IF 'PDCLM
IF CLMTYP=1
SET XREF="ACTVR"
+11 ; PRCA*4.5*349 (#3.01) CARC TRICARE W PYMNTS AUTO-DEC [1S]
IF XREF=""
IF 'PDCLM
IF CLMTYP=2
SET XREF="ACTVT"
+12 ; (#.08) CARC AUTO DECREASE NO-PAY [1S]
IF XREF=""
IF PDCLM
IF CLMTYP=0
SET XREF="ACTVN"
+13 ; PRCA*4.5*349 (#3.07) CARC TRICARE AUTO-DECRS NO-PAY [7S]
IF XREF=""
IF PDCLM
IF CLMTYP=2
SET XREF="ACTVNT"
+14 ;
+15 ; need a cross-reference, return zero
IF XREF=""
QUIT 0
+16 ; count entries on the cross-ref.
+17 SET NUM=0
SET I=""
FOR
SET I=$ORDER(^RCY(344.62,XREF,ACTVCARC,I))
if I=""
QUIT
SET NUM=NUM+1
+18 QUIT NUM
+19 ;
EXCLLIST(TYP) ; Display Payer Exclusion lists for Auto-Post and Auto-Decrease
+1 ; for Medical, Pharmacy and TRICARE
+2 ; PRCA*4.5*349 - Added Rx/TRICRE options
+3 ; Input: TYP - 1 - Medical Auto-Post payer exclusions
+4 ; 2 - Medical Auto-Decrease payer exclusions
+5 ; 3 - Rx Auto-Post payer exclusions
+6 ; 4 - Rx Auto-Decrease payer exclusions
+7 ; 5 - TRICARE Auto-Post payer exclusions
+8 ; 6 - TRICRE Auto-Decrease payer exclusions
+9 ;
+10 ; PRCA*4.5*349 - TYP must be valid
if '("^1^2^3^4^5^6^"[(U_$GET(TYP)_U))
QUIT
+11 NEW CT,EXCHDR,IEN,IX,LIST
+12 SET (IEN,CT)=0
+13 WRITE !
+14 ; Determine which index to used
+15 ; PRCA*4.5*345 Start modified code block - added Rx/TRICARE options
+16 IF TYP=1
Begin DoDot:1
+17 SET IX="EXMDPOST"
+18 SET LIST="Payers excluded from Medical Auto-Posting:"
End DoDot:1
+19 IF '$TEST
IF TYP=2
Begin DoDot:1
+20 SET IX="EXMDDECR"
+21 SET LIST="Additional Payers excluded from Medical Auto-Decrease:"
End DoDot:1
+22 IF '$TEST
IF TYP=3
Begin DoDot:1
+23 SET IX="EXRXPOST"
+24 SET LIST="Payers excluded from Pharmacy Auto-Posting:"
End DoDot:1
+25 IF '$TEST
IF TYP=4
Begin DoDot:1
+26 SET IX="EXRXDECR"
+27 SET LIST="Additional Payers excluded from Pharmacy Auto-Decrease:"
End DoDot:1
+28 ; PRCA*4.5*349 - Add TRICARE
+29 IF '$TEST
IF TYP=5
Begin DoDot:1
+30 SET IX="EXTRPOST"
+31 SET LIST="Additional Payers excluded from TRICARE Auto-Posting:"
End DoDot:1
+32 IF '$TEST
Begin DoDot:1
+33 SET IX="EXTRDECR"
+34 SET LIST="Additional Payers excluded from TRICARE Auto-Decrease:"
End DoDot:1
+35 ;
+36 ; if list is for auto-decrease and there are exclusions write a message
+37 SET (IEN,CT)=0
+38 FOR
Begin DoDot:1
+39 SET IEN=$ORDER(^RCY(344.6,IX,1,IEN))
+40 if 'IEN
QUIT
+41 SET CT=CT+1
+42 if CT=1
WRITE !,LIST
+43 WRITE !," "_$PIECE(^RCY(344.6,IEN,0),U,1)_" "_$PIECE(^RCY(344.6,IEN,0),U,2)
End DoDot:1
if 'IEN
QUIT
+44 ;
+45 IF TYP=2!(TYP=4)!(TYP=6)
Begin DoDot:1
+46 WRITE !,"All payers excluded from Auto-Posting are also excluded from Auto-Decrease."
End DoDot:1
+47 ;
+48 IF CT=0
WRITE !," No "_LIST
+49 ; PRCA*4.5*349 - End modified code block
+50 QUIT
+51 ;
SETEXCL(TYP) ; LOOP FOR SETTING PAYER EXCLUSIONS for Medical, Rx and TRICARE and Auto-Decrease payer exclusions
+1 ; PRCA*4.5*349 - Added Rx/TRICARE sets
+2 ; Input: TYP - 1 - Set Medical Auto-Post payer exclusions
+3 ; 2 - Set Medical Auto-Decrease payer exclusions
+4 ; 3 - Set Rx Auto-Post payer exclusions
+5 ; 4 - Set Rxl Auto-Decrease payer exclusions
+6 ; 5 - Set TRICARE Auto-Post payer exclusions
+7 ; 6 - Set TRICARE Auto-Decrease payer exclusions
+8 ; Returns: 1 - User '^' or timed out
+9 ; 0 otherwise
+10 ;
+11 NEW CMT,CT,DIC,DIR,DONE,FDAPAYER,FLD,IEN,PREC,RCAUDVAL,RCQUIT,RTYP,X,XX,Y
+12 ; PRCA*4.5*349 - Added Rx/TRICARE claims decrease
+13 IF $GET(TYP)=1
SET FLD=.06
SET CMT=1
SET RTYP="MEDICAL CLAIMS POSTING"
+14 IF '$TEST
IF $GET(TYP)=2
SET FLD=.07
SET CMT=2
SET RTYP="MEDICAL CLAIMS DECREASE"
+15 IF '$TEST
IF $GET(TYP)=3
SET FLD=.08
SET CMT=3
SET RTYP="PHARMACY CLAIMS POSTING"
+16 IF '$TEST
IF $GET(TYP)=4
SET FLD=.12
SET CMT=4
SET RTYP="PHARMACY CLAIMS DECREASE"
+17 IF '$TEST
IF $GET(TYP)=5
SET FLD=.13
SET CMT=5
SET RTYP="TRICARE CLAIMS POSTING"
+18 IF '$TEST
SET FLD=.14
SET CMT=6
SET RTYP="TRICARE CLAIMS DECREASE"
+19 ;
+20 WRITE !!,"Select a Payer to add or remove from the exclusion list.",!
+21 SET (RCQUIT,CT,DONE)=0
+22 FOR
if DONE!RCQUIT
QUIT
Begin DoDot:1
+23 SET DIC="^RCY(344.6,"
SET DIC(0)="AEMQZ"
SET DIC("A")="Payer: "
+24 ; PRCA*4.5*349
SET DIC("S")="I $$PAYTYP^RCDPESPB("_TYP_","_FLD_")"
+25 DO ^DIC
+26 IF X="^"
SET RCQUIT=1
QUIT
+27 IF +$GET(Y)<1
SET DONE=1
QUIT
+28 SET CT=CT+1
SET IEN=+Y
SET PREC=Y(0)
+29 KILL FDAPAYER
+30 NEW COMMENT,STAT
+31 SET COMMENT=""
SET STAT='$$GET1^DIQ(344.6,IEN_",",FLD,"I")
+32 SET FDAPAYER(344.6,IEN_",",FLD)=STAT
+33 ; GET COMMENT HERE
+34 KILL Y
SET DIR("A")="COMMENT: "
SET DIR(0)="FA^3:72"
+35 ; comment required and should be significant
SET DIR("PRE")="S X=$$TRIM^XLFSTR(X,""LR"")"
+36 SET DIR("?")="Enter an explanation for "_$SELECT(STAT:"adding the payer to",1:"removing the payer from")_" the list of Excluded Payers."
+37 SET XX="Enter an explanation for "
+38 SET XX=XX_$SELECT(STAT:"adding the payer to",1:"removing the payer from")
+39 SET DIR("?")=XX_" the list of Excluded Payers."
+40 DO ^DIR
+41 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCQUIT=1
QUIT
+42 ; stop loop
IF Y=""
SET DONE=1
QUIT
+43 SET COMMENT=Y
+44 IF COMMENT'=""
Begin DoDot:2
+45 SET FDAPAYER(344.6,IEN_",",CMT)=$SELECT(STAT:COMMENT,1:"")
+46 WRITE !,$PIECE(PREC,U)_" "_$PIECE(PREC,U,2)_" has been "_$SELECT(STAT:"added to",1:"removed from")_" the list of Excluded Payers"
+47 IF TYP=1
Begin DoDot:3
+48 WRITE !,"If Medical Auto-Decrease is turned on, "
+49 IF STAT
WRITE "this payer will be excluded from Medical Auto-Decrease too."
+50 IF 'STAT
IF '$$GET1^DIQ(344.6,IEN_",",.07,"I")
WRITE "this payer will no longer be excluded from Medical Auto-Decrease."
+51 IF 'STAT
IF $$GET1^DIQ(344.6,IEN_",",.07,"I")
WRITE "Medical Auto-Decrease is set to be excluded for this payer."
End DoDot:3
+52 ;
+53 ; PRCA*4.5*349 - Added if below
+54 IF TYP=3
Begin DoDot:3
+55 WRITE !,"If pharmacy auto-decrease is turned on, "
+56 IF STAT
WRITE "this payer will be excluded from Pharmacy auto-decrease too."
+57 IF 'STAT
IF '$$GET1^DIQ(344.6,IEN_",",.12,"I")
Begin DoDot:4
+58 WRITE "this payer will no longer be excluded from Pharmacy Auto-Decrease."
End DoDot:4
+59 IF 'STAT
IF $$GET1^DIQ(344.6,IEN_",",.12,"I")
Begin DoDot:4
+60 WRITE "Pharmacy Auto-Decrease is set to be excluded for this payer."
End DoDot:4
End DoDot:3
+61 ;
+62 ; PRCA*4.5*349 - Added if below
+63 IF TYP=5
Begin DoDot:3
+64 WRITE !,"If TRICARE auto-decrease is turned on, "
+65 IF STAT
WRITE "this payer will be excluded from TRICARE Auto-Decrease too."
+66 IF 'STAT
IF '$$GET1^DIQ(344.6,IEN_",",.14,"I")
Begin DoDot:4
+67 WRITE "this payer will no longer be excluded from TRICARE Auto-Decrease."
End DoDot:4
+68 IF 'STAT
IF $$GET1^DIQ(344.6,IEN_",",.14,"I")
Begin DoDot:4
+69 WRITE "TRICARE Auto-Decrease is set to be excluded for this payer."
End DoDot:4
End DoDot:3
+70 KILL RCAUDVAL
+71 DO FILE^DIE(,"FDAPAYER")
+72 SET RCAUDVAL(1)="344.6"_U_FLD_U_IEN_U_STAT_U_('STAT)_U_COMMENT
+73 DO AUDIT(.RCAUDVAL)
End DoDot:2
End DoDot:1
+74 ;
+75 QUIT RCQUIT
+76 ;
NOTIFY(VAL,TYPE) ; Notification of change to Site Parameters
+1 NEW C,G,GLB,MSG,SITE,SUBJ,XMINSTR,XMTO
+2 SET SITE=$$SITE^VASITE
+3 ; optional parameter
SET TYPE=$GET(TYPE)
+4 ; limit subject to 65 chars.
+5 SET SUBJ=$EXTRACT("Site Parameter edit, Station #"_$PIECE(SITE,U,3)_" - "_$PIECE(SITE,U,2),1,65)
+6 ; body of message
DO XMSGBODY^RCDPESPB(.MSG)
+7 ; line count
SET C=MSG
+8 SET C=C+1
+9 SET MSG(C)=" ENABLE AUTO-POSTING OF "_$SELECT(TYPE=1:"PHARMACY",TYPE=2:"TRICARE",1:"MEDICAL")_" CLAIMS = "
+10 SET MSG(C)=MSG(C)_$$FRMT^RCDPESP6(VAL,"B")
+11 SET C=C+1
SET MSG(C)=" "
+12 ;send message to mail group
+13 SET XMTO(DUZ)=""
SET XMTO("G.RCDPE AUDIT")=""
+14 KILL ^TMP("XMERR",$JOB)
+15 DO SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
+16 IF $DATA(^TMP("XMERR",$JOB))
Begin DoDot:1
+17 DO MES^XPDUTL("MailMan reported a problem trying to send the notification message.")
+18 DO MES^XPDUTL("MailMan error text:")
+19 SET (G,GLB)=$NAME(^TMP("XMERR",$JOB))
+20 FOR
SET G=$QUERY(@G)
if G'[GLB
QUIT
DO MES^XPDUTL(" "_@G)
+21 DO MES^XPDUTL("* End of MailMan Error *")
End DoDot:1
+22 QUIT
+23 ;
AUDIT(INP) ; WRITE AUDIT RECORD(S)
+1 ; INP = audit value in this format:
+2 ; FILE NUMBER^FIELD NUMBER^IEN^NEW VALUE^OLD VALUE^COMMENT
+3 ; nothing to audit
if '$ORDER(INP(0))
QUIT
+4 NEW RCI,RCNOW
+5 SET RCNOW=$$NOW^XLFDT
+6 SET RCI=0
FOR
SET RCI=$ORDER(INP(RCI))
if 'RCI
QUIT
Begin DoDot:1
+7 NEW FDAUDT,X
SET X=INP(RCI)
+8 ;TIMESTAMP [1D]
SET FDAUDT(344.7,"+1,",.01)=RCNOW
+9 ;MODIFIED IEN [2N]
SET FDAUDT(344.7,"+1,",.02)=$PIECE(X,U,3)
+10 ;CHANGED BY [3P:200]
SET FDAUDT(344.7,"+1,",.03)=DUZ
+11 ;CHANGED FIELD [4N]
SET FDAUDT(344.7,"+1,",.04)=$PIECE(X,U,2)
+12 ;MODIFIED FILE [5S]
SET FDAUDT(344.7,"+1,",.05)=$PIECE(X,U)
+13 ;NEW VALUE [6F]
SET FDAUDT(344.7,"+1,",.06)=$PIECE(X,U,4)
+14 ;OLD VALUE [7F]
SET FDAUDT(344.7,"+1,",.07)=$PIECE(X,U,5)
+15 ;COMMENT [8F]
SET FDAUDT(344.7,"+1,",.08)=$PIECE(X,U,6)
+16 DO UPDATE^DIE(,"FDAUDT")
End DoDot:1
+17 QUIT
+18 ;
+19 ; CALLS RELATED TO CREATING EPAYMENT PAYER EXCLUSION PARAMETERS
+20 ;
NEWPYR ;Add new payers to payer table - called from AR Nightly Job (EN^RCDPEM)
+1 ; PRCA*4.5*326 - Add payers that are just on EFTs to file 344.6
+2 NEW RCDATE,RCFDA,RCEFT,RCERA,RCUPD,RCXD
+3 ;Get date/time of last run otherwise start at previous day
+4 SET RCDATE=$PIECE($GET(^RCY(344.61,1,0)),U,8)
if RCDATE=""
SET RCDATE=$$FMADD^XLFDT($$NOW^XLFDT\1,-1)
+5 SET RCXD=RCDATE
+6 FOR
SET RCXD=$ORDER(^RCY(344.4,"AFD",RCXD))
if 'RCXD
QUIT
Begin DoDot:1
+7 ;
SET RCERA=""
FOR
SET RCERA=$ORDER(^RCY(344.4,"AFD",RCXD,RCERA))
if 'RCERA
QUIT
Begin DoDot:2
+8 SET RCUPD=$$PAYRINIT(RCERA,344.4)
End DoDot:2
End DoDot:1
+9 ;
+10 SET RCXD=$$FMADD^XLFDT($PIECE(RCDATE,".",1),-1)
+11 FOR
SET RCXD=$ORDER(^RCY(344.31,"ADR",RCXD))
if 'RCXD
QUIT
Begin DoDot:1
+12 ;
SET RCEFT=""
FOR
SET RCEFT=$ORDER(^RCY(344.31,"ADR",RCXD,RCEFT))
if 'RCEFT
QUIT
Begin DoDot:2
+13 SET RCUPD=$$PAYRINIT(RCEFT,344.31)
End DoDot:2
End DoDot:1
+14 ;
+15 ;Update last run date
+16 SET RCFDA(344.61,"1,",.08)=$$NOW^XLFDT()
+17 DO FILE^DIE("","RCFDA")
+18 ; PRCA*4.5*326 - End modified block
+19 QUIT
+20 ;
PAYERPRM(IEN,EXMDPOST,EXMDDECR) ; update new payer
+1 ; IEN valid?
if '$GET(IEN)!('$DATA(^RCY(344.4,+$GET(IEN),0)))
QUIT 0
+2 NEW ID,PAYER,PFDA,PIENS
+3 SET PAYER=$EXTRACT($$GET1^DIQ(344.4,IEN_",",.06),1,35)
+4 if PAYER=""
QUIT 0
+5 SET ID=$EXTRACT($$GET1^DIQ(344.4,IEN_",",.03),1,30)
+6 IF '$DATA(^RCY(344.6,"CPID",PAYER,ID))
QUIT 0
+7 ; FILE CURRENT SETTINGS
+8 SET PIENS=$ORDER(^RCY(344.6,"CPID",PAYER,ID,0))_","
+9 SET PFDA(344.6,PIENS,.04)=DUZ
+10 SET PFDA(344.6,PIENS,.05)=$$NOW^XLFDT
+11 SET PFDA(344.6,PIENS,.06)=+$GET(EXMDPOST)
+12 SET PFDA(344.6,PIENS,.07)=+$GET(EXMDDECR)
+13 DO FILE^DIE(,"PFDA")
+14 QUIT 1
+15 ;
PAYRINIT(IEN,FILE) ; Add Payer Name and Payer ID to Payer table #344.6
+1 ;
+2 NEW PFDA,PAYER,ID,PIENS,ERADATE,RCFLD
+3 ;
+4 if '$GET(IEN)!('$DATA(^RCY(FILE,+$GET(IEN))))
QUIT 0
+5 ; PRCA*4.5*326 - Add payers from EFTs
+6 SET RCFLD("NAME")=$SELECT(FILE=344.4:.06,1:.02)
+7 SET RCFLD("ID")=.03
+8 SET RCFLD("DATE")=$SELECT(FILE=344.4:.07,1:.13)
+9 ;
+10 SET PAYER=$$GET1^DIQ(FILE,IEN_",",RCFLD("NAME"))
if PAYER=""
QUIT 0
+11 SET ID=$$GET1^DIQ(FILE,IEN_",",RCFLD("ID"))
if ID=""
QUIT 0
+12 IF $DATA(^RCY(344.6,"CPID",PAYER,ID))
QUIT 1
+13 SET ERADATE=$$GET1^DIQ(FILE,IEN_",",RCFLD("DATE"),"I")
+14 ; PRCA*4.5*326 - End modified block
+15 ;
+16 ; UPDATE PAYER PARAMETERS
+17 SET PIENS="+1,"
+18 SET PFDA(344.6,PIENS,.01)=PAYER
+19 SET PFDA(344.6,PIENS,.02)=ID
+20 SET PFDA(344.6,PIENS,.03)=ERADATE
+21 SET PFDA(344.6,PIENS,.04)=.5
+22 SET PFDA(344.6,PIENS,.05)=$$NOW^XLFDT
+23 SET PFDA(344.6,PIENS,.06)=0
+24 SET PFDA(344.6,PIENS,.07)=0
+25 ; PRCA*4.5*326
IF FILE=344.31
SET PFDA(344.6,PIENS,.11)=1
+26 DO UPDATE^DIE(,"PFDA")
+27 QUIT 1
