RCDPESP6 ;AITC/CJE - ePayment Lockbox Site Parameters - Notify Changes;29 Jan 2019 18:00:14
;;4.5;Accounts Receivable;**326,332,345,349**;;Build 44
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; EP from RCDPESP
; On entry into parameter edit, save a snapshot of the files
; Input: None
; Output: ^TMP("RCDPESP6",$J) for files 344.6, 344.61 and 344.62
K ^TMP("RCDPESP6",$J)
M ^TMP("RCDPESP6",$J,344.6)=^RCY(344.6) ; RCDPE AUTO-PAY EXCLUSION
M ^TMP("RCDPESP6",$J,344.61)=^RCY(344.61) ; RCDPE PARAMETER
M ^TMP("RCDPESP6",$J,344.62)=^RCY(344.62) ; RCDPE CARC-RARC AUTO DEC
Q
;
EXIT ; EP from RCDPESP
; On exit compare snapshots with files
; sends mail message if any designated items have changed.
; Input: ^TMP($T(+0),$J) copies of files 344.6, 344.61 and 344.62
; Output: Mail message (if any parameters have changed)
;
N C,CHANGES,CHGCNT,G,LINES,RCMSGTXT,RCSITE,RCSUBJ,TXTLNS,XMINSTR,XMTO
;Check for changed parameters, if no changes, don't send message
S CHGCNT=$$CHKCHNG(.RCMSGTXT) ; Check for any changes in parameters ;
Q:'CHGCNT ; No changes made so don't send message
;
S RCSITE=$$SITE^VASITE()
S RCSUBJ=$E("ePayments EDI Lockbox Parameters changed "_$P(RCSITE,U,2),1,65)
D HEADER(.RCMSGTXT,RCSITE)
;
S XMINSTR("FROM")="POSTMASTER",XMTO(DUZ)="",XMTO("G.RCDPE AUDIT")=""
K ^TMP("XMERR",$J)
D SENDMSG^XMXAPI(DUZ,RCSUBJ,"RCMSGTXT",.XMTO,.XMINSTR)
;
I $D(^TMP("XMERR",$J)) D
. D MES^XPDUTL("MailMan returned an error.")
. D MES^XPDUTL("The error text is:")
. S G=$NA(^TMP("XMERR",$J))
. F S G=$Q(@G) Q:G="" Q:$QS(G,2)'=$J D MES^XPDUTL(" "_$C(34)_@G_$C(34))
. D MES^XPDUTL(" * End of Error Text *")
. K ^TMP("XMERR",$J)
;
K ^TMP("RCDPESP6",$J) ; Clean up
Q
;
; PRCA*4.5*349 - Re-write subroutine
; Output: Array MSGTXT passed by reference
; limit subject to 65 chars.
S MSGTXT(1)=" "
S MSGTXT(2)=" Site: "_$P(RCSITE,U,2)
S MSGTXT(3)=" Station # "_$P(RCSITE,U,3)
S MSGTXT(4)=" Domain: "_$G(^XMB("NETNAME"))
S MSGTXT(5)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"1ZPM")
S MSGTXT(6)=" User: "_$P($G(^VA(200,DUZ,0)),U)
S MSGTXT(7)=" "
S MSGTXT(8)=" The following EDI Lockbox Site Parameters were changed: "
S MSGTXT(9)=" "
S MSGTXT(10)=$J("",50)_$J("OLD VALUE",10)_" "_$J("NEW VALUE",10)
Q
;
CHKCHNG(LINE) ;function, check for changes in EDI Lockbox site parameters
; PRCA*4.5*345 - Added checks for Auto-Decrease Rx/TRICARE parameters
; Input:
; ^TMP($T(+0),$J): Copies of file 344.6, 344.61 and 344.62 taken on entry
;Output:
; LINE: Change for mail message, Passed by reference
; Returns number of changes
N COUNT,HEAD,REC0,REC1,REC2,XNEW,XOLD
S (COUNT,HEAD)=0,HEAD("SIZE")=10
S HEAD("TXT")="ALL PAYERS",HEAD("DETAIL")=""
;
; Check parameters in 344.61 that apply to all payers
; PRCA*4.5*345 added new subroutines
D MEDCHNG(.HEAD,.COUNT,.LINE) ; Medical parameter changes
D RXCHNG(.HEAD,.COUNT,.LINE) ; Pharmacy parameter changes
D TRICHNG(.HEAD,.COUNT,.LINE) ; PRCA*4.5*349 - Check for TRICARE parameter changes
D PAYEXC(.COUNT,.LINE) ; Payer exclusions parameter changes
D CARCHNG(.COUNT,.LINE) ; CARC-RARC parameter changes
Q COUNT
;
MEDCHNG(HEAD,COUNT,LINE) ; Check for Medical site parameter changes - PRCA*4.5*345
;these parameters passed by reference:
; HEAD: See LNOUT for details
; COUNT: count of parameter changes
; LINE: Array of site parameter changes
N MEDND,XNEW,XOLD
S MEDND=^TMP($T(+0),$J,344.61,1,0)
; Auto-post med claims enabled
S XOLD=$P(MEDND,U,2),XNEW=$$GET1^DIQ(344.61,"1,",.02,"I")
I XNEW'=XOLD D
. D LNOUT(.HEAD,.LINE,"AUTO-POST MED CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT)
;
; Auto-decrease med enabled
S XOLD=$P(MEDND,U,3),XNEW=$$GET1^DIQ(344.61,"1,",.03,"I")
I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE MED ENABLED",XOLD,XNEW,"B",.COUNT)
;
; Auto-decrease med days
S XOLD=$P(MEDND,U,4),XNEW=$$GET1^DIQ(344.61,"1,",.04,"I")
I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
;
; Auto-decrease no-pay med enabled
S XOLD=$P(MEDND,U,11),XNEW=$$GET1^DIQ(344.61,"1,",.11,"I")
I XNEW'=XOLD D ;
. D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY MED ENABLED",XOLD,XNEW,"B",.COUNT)
;
; Auto-decrease no-pay med days
S XOLD=$P(MEDND,U,12),XNEW=$$GET1^DIQ(344.61,"1,",.12,"I")
I XNEW'=XOLD D ;
. D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
;
; Maximum dollar amount to Auto-Decrease medical claims
S XOLD=$P(MEDND,U,5),XNEW=$$GET1^DIQ(344.61,"1,",.05,"I")
I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE MED MAX AMT",XOLD,XNEW,"$",.COUNT)
Q
;
RXCHNG(HEAD,COUNT,LINE) ; Check for Rx site parameter changes PRCA*4.5*345
;these parameters passed by reference:
; HEAD: See LNOUT for details
; COUNT: count of parameter changes
; LINE: Array of site parameter changes
N RXND,XNEW,XOLD
S RXND=$G(^TMP($T(+0),$J,344.61,1,1))
; Auto-Post Rx
S XOLD=$P(RXND,U,1),XNEW=$$GET1^DIQ(344.61,"1,",1.01,"I")
I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-POST RX CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT)
;
; Auto-Decrease Rx enabled
S XOLD=$P(RXND,U,2),XNEW=$$GET1^DIQ(344.61,"1,",1.02,"I")
I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX ENABLED",XOLD,XNEW,"B",.COUNT)
;
; Auto-decrease Rx days
S XOLD=$P(RXND,U,3),XNEW=$$GET1^DIQ(344.61,"1,",1.03,"I")
I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
;
; Maximum dollar amount to Auto-Decrease Rx claims
S XOLD=$P(RXND,U,4),XNEW=$$GET1^DIQ(344.61,"1,",1.04,"I")
I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX MAX AMT",XOLD,XNEW,"$",.COUNT)
Q
;
; PRCA*4.5*349 - Subroutine re-written
TRICHNG(HEAD,COUNT,LINE) ; Check for TRICARE site parameter changes
; Input: HEAD - See subroutine LNOUT for details
; COUNT - Current # of parameter changes
; LINE - Array of current site parameter changes
; Output: COUNT - Updated # of parameter changes
; LINE - Array of updated site parameter changes
;
N REC0,REC1,XNEW,XOLD
S REC0=^TMP("RCDPESP6",$J,344.61,1,0) ; Original Site parameters
S REC1=^TMP("RCDPESP6",$J,344.61,1,1)
; Auto-post TRICARE claims enabled
S XOLD=$P(REC1,U,5)
S XNEW=$$GET1^DIQ(344.61,"1,",1.05,"I")
I XNEW'=XOLD D
. D LNOUT(.HEAD,.LINE,"AUTO-POST TRI CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT)
;
; Auto-decrease TRICARE enabled
S XOLD=$P(REC1,U,6)
S XNEW=$$GET1^DIQ(344.61,"1,",1.06,"I")
I XNEW'=XOLD D
. D LNOUT(.HEAD,.LINE,"AUTO-DECREASE TRI ENABLED",XOLD,XNEW,"B",.COUNT)
;
; Auto-decrease TRICARE days
S XOLD=$P(REC1,U,8)
S XNEW=$$GET1^DIQ(344.61,"1,",1.08,"I")
I XNEW'=XOLD D
. D LNOUT(.HEAD,.LINE,"AUTO-DECREASE TRI DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
;
; Auto-decrease no-pay TRICARE enabled
S XOLD=$P(REC1,U,9)
S XNEW=$$GET1^DIQ(344.61,"1,",1.09,"I")
I XNEW'=XOLD D ;
. D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY TRI ENABLED",XOLD,XNEW,"B",.COUNT)
;
; Auto-decrease no-pay TRICARE days
S XOLD=$P(REC1,U,10)
S XNEW=$$GET1^DIQ(344.61,"1,",1.1,"I")
I XNEW'=XOLD D ;
. D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY TRI DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
;
; Maximum dollar amount to Auto-Decrease TRICARE claims
S XOLD=$P(REC1,U,7)
S XNEW=$$GET1^DIQ(344.61,"1,",1.07,"I")
I XNEW'=XOLD D
. D LNOUT(.HEAD,.LINE,"AUTO-DECREASE TRI MAX AMT",XOLD,XNEW,"$",.COUNT)
;
; TRICARE EFT POST PREVENT DAYS - PRCA*4.5*332
S XOLD=$P(REC0,U,13)
S XNEW=$$GET1^DIQ(344.61,"1,",.13,"I")
I XNEW'=XOLD D
. D LNOUT(.HEAD,.LINE,"TRICARE EFT POST PREVENT DAYS",XOLD,XNEW,"D",.COUNT)
Q
;
PAYEXC(COUNT,LINE) ; Check for Payer Auto-Post and Auto-Decrease exclusions PRCA*4.5*345
;Input:
; COUNT: count of parameter changes
; LINE: Array of site parameter changes
; ^TMP($T(+0),$J,344.6): Original Payer exclusions
;Output:
; COUNT: Updated # of parameter changes
; LINE: Array of updated site parameter changes
N IEN,REC0,XNEW,XOLD
;
; Check each payer in 344.6 for changes
S IEN=0 F S IEN=$O(^RCY(344.6,IEN)) Q:'IEN D
. S REC0=$G(^TMP($T(+0),$J,344.6,IEN,0))
. S HEAD=0
. S HEAD("DETAIL")=$$GET1^DIQ(344.6,IEN_",",.01,"E"),HEAD("TXT")="PAYER: "_HEAD("DETAIL") ; PRCA*4.5*332
. ; Exclude med claims posting
. S XOLD=$P(REC0,U,6),XNEW=$$GET1^DIQ(344.6,IEN_",",.06,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE MED CLAIMS POSTING",XOLD,XNEW,"B",.COUNT)
. ;
. ; Exclude med claims decrease
. S XOLD=$P(REC0,U,7),XNEW=$$GET1^DIQ(344.6,IEN_",",.07,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE MED CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT)
. ;
. ; Exclude Rx claim posting
. S XOLD=$P(REC0,U,8),XNEW=$$GET1^DIQ(344.6,IEN_",",.08,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE RX CLAIM POSTING",XOLD,XNEW,"B",.COUNT)
. ;
. ; Exclude Rx claims decrease
. S XOLD=$P(REC0,U,12),XNEW=$$GET1^DIQ(344.6,IEN_",",.12,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE RX CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT)
. ;
. ; PRCA*4.5*349 - Begin modified block
. ; Exclude TRICARE claims posting
. S XOLD=$P(REC0,U,13),XNEW=$$GET1^DIQ(344.6,IEN_",",.13,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE TRICARE CLAIMS POSTING",XOLD,XNEW,"B",.COUNT)
. ;
. ; Exclude TRICARE claims decrease
. S XOLD=$P(REC0,U,14),XNEW=$$GET1^DIQ(344.6,IEN_",",.14,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE TRICARE CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT)
. ; PRCA*4.5*349 - End modified block
Q
;
CARCHNG(COUNT,LINE) ; Check for CARC-RARC parameter changes
; PRCA*4.5*345 - New method
;Input, passed by reference:
; COUNT: # of parameter changes
; LINE: array of site parameter changes
; ^TMP($T(+0),$J,344.62): Original CARC-RARC values
;Output:
; COUNT: updated # of parameter changes
; LINE: updated array
N IEN,REC,XNEW,XOLD
;
; Check entries in 344.62 for changes
S IEN=0 F S IEN=$O(^RCY(344.62,IEN)) Q:'IEN D
. S REC(0)=$G(^TMP($T(+0),$J,344.62,IEN,0))
. S REC(1)=$G(^TMP($T(+0),$J,344.62,IEN,1))
. S REC(2)=$G(^TMP($T(+0),$J,344.62,IEN,2))
. S REC(3)=$G(^TMP($T(+0),$J,344.62,IEN,3)) ; PRCA*3.4*349 TRICARE Auto-Decrease
. S HEAD=0
. S HEAD("DETAIL")=$$GET1^DIQ(344.62,IEN_",",.01,"E") ; PRCA*4.5*332
. S HEAD("TXT")="CARC/RARC CODE: "_HEAD("DETAIL")
. ;
. ; PRCA*4.5*345 - Changed descriptions below
. ; CARC Medical Claims w/Payments Auto-Decrease
. S XOLD=$P(REC(0),U,2),XNEW=$$GET1^DIQ(344.62,IEN_",",.02,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC MED PAY AUTO-DECREASE",XOLD,XNEW,"B",.COUNT)
. ; CARC Medical Claims w/Payments Auto-Decrease amount
. S XOLD=$P(REC(0),U,6),XNEW=$$GET1^DIQ(344.62,IEN_",",.06,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC MED PAY DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT)
. ; CARC Medical Claims w/No Payments Auto-Decrease
. S XOLD=$P(REC(1),U,1),XNEW=$$GET1^DIQ(344.62,IEN_",",.08,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC AUTO-DECREASE MED NO-PAY",XOLD,XNEW,"B",.COUNT)
. ; CARC Medical Claims w/No Payments Auto-Decrease amount
. S XOLD=$P(REC(1),U,5),XNEW=$$GET1^DIQ(344.62,IEN_",",.12,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC DECREASE AMOUNT MED NO-PAY",XOLD,XNEW,"$",.COUNT)
. ; CARC Rx w/Payments Auto-Decrease
. S XOLD=$P(REC(2),U,1),XNEW=$$GET1^DIQ(344.62,IEN_",",2.01,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC RX PAY AUTO-DECREASE",XOLD,XNEW,"B",.COUNT)
. ; CARC Rx w/Payments Auto-Decrease amount
. S XOLD=$P(REC(2),U,5),XNEW=$$GET1^DIQ(344.62,IEN_",",2.05,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC RX PAY DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT)
. ; PRCA*4.5*349 - Begin Modified Block
. ; CARC TRICARE w/Payments Auto-Decrease
. S XOLD=$P(REC(3),U,1),XNEW=$$GET1^DIQ(344.62,IEN_",",3.01,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC TRICARE PAY AUTO-DECREASE",XOLD,XNEW,"B",.COUNT)
. ; CARC TRICARE w/Payments Auto-Decrease amount
. S XOLD=$P(REC(3),U,5),XNEW=$$GET1^DIQ(344.62,IEN_",",3.05,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC TRICARE PAY DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT)
. ; CARC TRICARE w/No Payments Auto-Decrease
. S XOLD=$P(REC(3),U,7),XNEW=$$GET1^DIQ(344.62,IEN_",",3.07,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC TRICARE AUTO-DECREASE NO-PAY",XOLD,XNEW,"B",.COUNT)
. ; CARC TRICARE w/No Payments Auto-Decrease amount
. S XOLD=$P(REC(3),U,11),XNEW=$$GET1^DIQ(344.62,IEN_",",3.11,"I")
. I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC TRICARE DECREASE AMOUNT NO-PAY",XOLD,XNEW,"$",.COUNT)
. ; PRCA*4.5*349 - End Modified Block
Q
;
LNOUT(HEAD,LINE,TXT,XOLD,XNEW,TYPE,COUNT) ; Format a line for the message
; PRCA*4.5*345 - Added parameter documentation
;Input: HEAD: 0 if header not output into the line array for this section yet, 1 otherwise
; HEAD("SIZE"): 10
; LINE: array with parameter changes for the current section
; TXT: Description of the changed field
; XOLD: Old Value (Internal format)
; XNEW: New Value (Internal Format)
; TYPE: "B" - Boolean, "$" - Dollar amount, "D" - Days, "T" - Text
; COUNT: count of changes
;Output: HEAD: 1 if it came in as 0
; LINE: Updated array of lines detail parameter changes for the current section
; COUNT: Updated # of changes
;
N DOTS,RCFDA,RCIENS,Y
S DOTS=$TR($J(" ",50)," ",".")
;
; Output header for this section if not done
I 'HEAD S COUNT=COUNT+1,LINE(COUNT+HEAD("SIZE"))=HEAD("TXT"),HEAD=1
;
S Y=$E(" "_TXT_" "_DOTS,1,50)_$J($$FRMT(XOLD,TYPE),10)_" "_$J($$FRMT(XNEW,TYPE),10)
S COUNT=COUNT+1,LINE(COUNT+HEAD("SIZE"))=Y
;
;PRCA*4.5*332 save changes into multiple 344.611 for history report
S RCIENS="+1,1,"
S RCFDA(344.611,RCIENS,.01)=$$NOW^XLFDT
S RCFDA(344.611,RCIENS,.02)=DUZ
S RCFDA(344.611,RCIENS,1)=TXT
S RCFDA(344.611,RCIENS,2)=HEAD("DETAIL")
S RCFDA(344.611,RCIENS,3)=$$FRMT(XOLD,TYPE)
S RCFDA(344.611,RCIENS,4)=$$FRMT(XNEW,TYPE)
D UPDATE^DIE("","RCFDA","RCIENS")
Q
;
FRMT(VAL,TP) ;function, format value, added PRCA*4.5*332
; Input: VAL - Value to be formatted
; TP - "$" - Dollar amount, B - Boolean, D - Days
; Returns formatted value
N RTRN S RTRN=VAL
S:TP="B" RTRN=$S(VAL:"Yes",1:"No")
S:TP="$" RTRN="$"_$FN(VAL,",")
Q RTRN
;
PAYEN ; save snapshot of file 344.6, added PRCA*4.5*332
; Input: None
; Output: ^TMP($T(+0),$J) created by merging in files 344.6, 344.61 and 344.62
K ^TMP($T(+0),$J)
M ^TMP($T(+0),$J,344.6)=^RCY(344.6) ; Save payer exclusions
Q
;
PAYEX ; (EN) On exit from identify payers option, compare snapshot with live files. - Added for PRCA*4.5*332
; Save changes to the parameter audit multiple 344.611
; Input: ^TMP($T(+0),$J) created above by merging in file 344.6
; Output: Enties in multiple 344.611 to keep history of payer flag changes
;
N COUNT,HEAD,IEN,LINE,REC0,XNEW,XOLD
;
S HEAD=0,HEAD("SIZE")=10,COUNT=0
; Check each payer in 344.6 for changes
S IEN=0
F S IEN=$O(^RCY(344.6,IEN)) Q:'IEN D ;
. S REC0=$G(^TMP($T(+0),$J,344.6,IEN,0))
. S HEAD("DETAIL")=$$GET1^DIQ(344.6,IEN_",",.01,"E"),HEAD("TXT")="PAYER: "_HEAD("DETAIL")
. ; Pharmacy Flag
. S XOLD=$P(REC0,U,9),XNEW=$$GET1^DIQ(344.6,IEN_",",.09,"I")
. I (+XOLD)'=(+XNEW) D LNOUT(.HEAD,.LINE,"PHARMACY FLAG",XOLD,XNEW,"B",.COUNT)
. ; Tricare flag
. S XOLD=$P(REC0,U,10),XNEW=$$GET1^DIQ(344.6,IEN_",",.1,"I")
. I (+XOLD)'=(+XNEW) D LNOUT(.HEAD,.LINE,"TRICARE FLAG",XOLD,XNEW,"B",.COUNT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPESP6 15627 printed Apr 09, 2024@20:54:44 Page 2
RCDPESP6 ;AITC/CJE - ePayment Lockbox Site Parameters - Notify Changes;29 Jan 2019 18:00:14
+1 ;;4.5;Accounts Receivable;**326,332,345,349**;;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; EP from RCDPESP
+1 ; On entry into parameter edit, save a snapshot of the files
+2 ; Input: None
+3 ; Output: ^TMP("RCDPESP6",$J) for files 344.6, 344.61 and 344.62
+4 KILL ^TMP("RCDPESP6",$JOB)
+5 ; RCDPE AUTO-PAY EXCLUSION
MERGE ^TMP("RCDPESP6",$JOB,344.6)=^RCY(344.6)
+6 ; RCDPE PARAMETER
MERGE ^TMP("RCDPESP6",$JOB,344.61)=^RCY(344.61)
+7 ; RCDPE CARC-RARC AUTO DEC
MERGE ^TMP("RCDPESP6",$JOB,344.62)=^RCY(344.62)
+8 QUIT
+9 ;
EXIT ; EP from RCDPESP
+1 ; On exit compare snapshots with files
+2 ; sends mail message if any designated items have changed.
+3 ; Input: ^TMP($T(+0),$J) copies of files 344.6, 344.61 and 344.62
+4 ; Output: Mail message (if any parameters have changed)
+5 ;
+6 NEW C,CHANGES,CHGCNT,G,LINES,RCMSGTXT,RCSITE,RCSUBJ,TXTLNS,XMINSTR,XMTO
+7 ;Check for changed parameters, if no changes, don't send message
+8 ; Check for any changes in parameters ;
SET CHGCNT=$$CHKCHNG(.RCMSGTXT)
+9 ; No changes made so don't send message
if 'CHGCNT
QUIT
+10 ;
+11 SET RCSITE=$$SITE^VASITE()
+12 SET RCSUBJ=$EXTRACT("ePayments EDI Lockbox Parameters changed "_$PIECE(RCSITE,U,2),1,65)
+13 DO HEADER(.RCMSGTXT,RCSITE)
+14 ;
+15 SET XMINSTR("FROM")="POSTMASTER"
SET XMTO(DUZ)=""
SET XMTO("G.RCDPE AUDIT")=""
+16 KILL ^TMP("XMERR",$JOB)
+17 DO SENDMSG^XMXAPI(DUZ,RCSUBJ,"RCMSGTXT",.XMTO,.XMINSTR)
+18 ;
+19 IF $DATA(^TMP("XMERR",$JOB))
Begin DoDot:1
+20 DO MES^XPDUTL("MailMan returned an error.")
+21 DO MES^XPDUTL("The error text is:")
+22 SET G=$NAME(^TMP("XMERR",$JOB))
+23 FOR
SET G=$QUERY(@G)
if G=""
QUIT
if $QSUBSCRIPT(G,2)'=$JOB
QUIT
DO MES^XPDUTL(" "_$CHAR(34)_@G_$CHAR(34))
+24 DO MES^XPDUTL(" * End of Error Text *")
+25 KILL ^TMP("XMERR",$JOB)
End DoDot:1
+26 ;
+27 ; Clean up
KILL ^TMP("RCDPESP6",$JOB)
+28 QUIT
+29 ;
+30 ; PRCA*4.5*349 - Re-write subroutine
+1 ; Output: Array MSGTXT passed by reference
+2 ; limit subject to 65 chars.
+3 SET MSGTXT(1)=" "
+4 SET MSGTXT(2)=" Site: "_$PIECE(RCSITE,U,2)
+5 SET MSGTXT(3)=" Station # "_$PIECE(RCSITE,U,3)
+6 SET MSGTXT(4)=" Domain: "_$GET(^XMB("NETNAME"))
+7 SET MSGTXT(5)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"1ZPM")
+8 SET MSGTXT(6)=" User: "_$PIECE($GET(^VA(200,DUZ,0)),U)
+9 SET MSGTXT(7)=" "
+10 SET MSGTXT(8)=" The following EDI Lockbox Site Parameters were changed: "
+11 SET MSGTXT(9)=" "
+12 SET MSGTXT(10)=$JUSTIFY("",50)_$JUSTIFY("OLD VALUE",10)_" "_$JUSTIFY("NEW VALUE",10)
+13 QUIT
+14 ;
CHKCHNG(LINE) ;function, check for changes in EDI Lockbox site parameters
+1 ; PRCA*4.5*345 - Added checks for Auto-Decrease Rx/TRICARE parameters
+2 ; Input:
+3 ; ^TMP($T(+0),$J): Copies of file 344.6, 344.61 and 344.62 taken on entry
+4 ;Output:
+5 ; LINE: Change for mail message, Passed by reference
+6 ; Returns number of changes
+7 NEW COUNT,HEAD,REC0,REC1,REC2,XNEW,XOLD
+8 SET (COUNT,HEAD)=0
SET HEAD("SIZE")=10
+9 SET HEAD("TXT")="ALL PAYERS"
SET HEAD("DETAIL")=""
+10 ;
+11 ; Check parameters in 344.61 that apply to all payers
+12 ; PRCA*4.5*345 added new subroutines
+13 ; Medical parameter changes
DO MEDCHNG(.HEAD,.COUNT,.LINE)
+14 ; Pharmacy parameter changes
DO RXCHNG(.HEAD,.COUNT,.LINE)
+15 ; PRCA*4.5*349 - Check for TRICARE parameter changes
DO TRICHNG(.HEAD,.COUNT,.LINE)
+16 ; Payer exclusions parameter changes
DO PAYEXC(.COUNT,.LINE)
+17 ; CARC-RARC parameter changes
DO CARCHNG(.COUNT,.LINE)
+18 QUIT COUNT
+19 ;
MEDCHNG(HEAD,COUNT,LINE) ; Check for Medical site parameter changes - PRCA*4.5*345
+1 ;these parameters passed by reference:
+2 ; HEAD: See LNOUT for details
+3 ; COUNT: count of parameter changes
+4 ; LINE: Array of site parameter changes
+5 NEW MEDND,XNEW,XOLD
+6 SET MEDND=^TMP($TEXT(+0),$JOB,344.61,1,0)
+7 ; Auto-post med claims enabled
+8 SET XOLD=$PIECE(MEDND,U,2)
SET XNEW=$$GET1^DIQ(344.61,"1,",.02,"I")
+9 IF XNEW'=XOLD
Begin DoDot:1
+10 DO LNOUT(.HEAD,.LINE,"AUTO-POST MED CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT)
End DoDot:1
+11 ;
+12 ; Auto-decrease med enabled
+13 SET XOLD=$PIECE(MEDND,U,3)
SET XNEW=$$GET1^DIQ(344.61,"1,",.03,"I")
+14 IF XNEW'=XOLD
DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE MED ENABLED",XOLD,XNEW,"B",.COUNT)
+15 ;
+16 ; Auto-decrease med days
+17 SET XOLD=$PIECE(MEDND,U,4)
SET XNEW=$$GET1^DIQ(344.61,"1,",.04,"I")
+18 IF XNEW'=XOLD
DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
+19 ;
+20 ; Auto-decrease no-pay med enabled
+21 SET XOLD=$PIECE(MEDND,U,11)
SET XNEW=$$GET1^DIQ(344.61,"1,",.11,"I")
+22 ;
IF XNEW'=XOLD
Begin DoDot:1
+23 DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY MED ENABLED",XOLD,XNEW,"B",.COUNT)
End DoDot:1
+24 ;
+25 ; Auto-decrease no-pay med days
+26 SET XOLD=$PIECE(MEDND,U,12)
SET XNEW=$$GET1^DIQ(344.61,"1,",.12,"I")
+27 ;
IF XNEW'=XOLD
Begin DoDot:1
+28 DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
End DoDot:1
+29 ;
+30 ; Maximum dollar amount to Auto-Decrease medical claims
+31 SET XOLD=$PIECE(MEDND,U,5)
SET XNEW=$$GET1^DIQ(344.61,"1,",.05,"I")
+32 IF XNEW'=XOLD
DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE MED MAX AMT",XOLD,XNEW,"$",.COUNT)
+33 QUIT
+34 ;
RXCHNG(HEAD,COUNT,LINE) ; Check for Rx site parameter changes PRCA*4.5*345
+1 ;these parameters passed by reference:
+2 ; HEAD: See LNOUT for details
+3 ; COUNT: count of parameter changes
+4 ; LINE: Array of site parameter changes
+5 NEW RXND,XNEW,XOLD
+6 SET RXND=$GET(^TMP($TEXT(+0),$JOB,344.61,1,1))
+7 ; Auto-Post Rx
+8 SET XOLD=$PIECE(RXND,U,1)
SET XNEW=$$GET1^DIQ(344.61,"1,",1.01,"I")
+9 IF XNEW'=XOLD
DO LNOUT(.HEAD,.LINE,"AUTO-POST RX CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT)
+10 ;
+11 ; Auto-Decrease Rx enabled
+12 SET XOLD=$PIECE(RXND,U,2)
SET XNEW=$$GET1^DIQ(344.61,"1,",1.02,"I")
+13 IF XNEW'=XOLD
DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX ENABLED",XOLD,XNEW,"B",.COUNT)
+14 ;
+15 ; Auto-decrease Rx days
+16 SET XOLD=$PIECE(RXND,U,3)
SET XNEW=$$GET1^DIQ(344.61,"1,",1.03,"I")
+17 IF XNEW'=XOLD
DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
+18 ;
+19 ; Maximum dollar amount to Auto-Decrease Rx claims
+20 SET XOLD=$PIECE(RXND,U,4)
SET XNEW=$$GET1^DIQ(344.61,"1,",1.04,"I")
+21 IF XNEW'=XOLD
DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX MAX AMT",XOLD,XNEW,"$",.COUNT)
+22 QUIT
+23 ;
+24 ; PRCA*4.5*349 - Subroutine re-written
TRICHNG(HEAD,COUNT,LINE) ; Check for TRICARE site parameter changes
+1 ; Input: HEAD - See subroutine LNOUT for details
+2 ; COUNT - Current # of parameter changes
+3 ; LINE - Array of current site parameter changes
+4 ; Output: COUNT - Updated # of parameter changes
+5 ; LINE - Array of updated site parameter changes
+6 ;
+7 NEW REC0,REC1,XNEW,XOLD
+8 ; Original Site parameters
SET REC0=^TMP("RCDPESP6",$JOB,344.61,1,0)
+9 SET REC1=^TMP("RCDPESP6",$JOB,344.61,1,1)
+10 ; Auto-post TRICARE claims enabled
+11 SET XOLD=$PIECE(REC1,U,5)
+12 SET XNEW=$$GET1^DIQ(344.61,"1,",1.05,"I")
+13 IF XNEW'=XOLD
Begin DoDot:1
+14 DO LNOUT(.HEAD,.LINE,"AUTO-POST TRI CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT)
End DoDot:1
+15 ;
+16 ; Auto-decrease TRICARE enabled
+17 SET XOLD=$PIECE(REC1,U,6)
+18 SET XNEW=$$GET1^DIQ(344.61,"1,",1.06,"I")
+19 IF XNEW'=XOLD
Begin DoDot:1
+20 DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE TRI ENABLED",XOLD,XNEW,"B",.COUNT)
End DoDot:1
+21 ;
+22 ; Auto-decrease TRICARE days
+23 SET XOLD=$PIECE(REC1,U,8)
+24 SET XNEW=$$GET1^DIQ(344.61,"1,",1.08,"I")
+25 IF XNEW'=XOLD
Begin DoDot:1
+26 DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE TRI DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
End DoDot:1
+27 ;
+28 ; Auto-decrease no-pay TRICARE enabled
+29 SET XOLD=$PIECE(REC1,U,9)
+30 SET XNEW=$$GET1^DIQ(344.61,"1,",1.09,"I")
+31 ;
IF XNEW'=XOLD
Begin DoDot:1
+32 DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY TRI ENABLED",XOLD,XNEW,"B",.COUNT)
End DoDot:1
+33 ;
+34 ; Auto-decrease no-pay TRICARE days
+35 SET XOLD=$PIECE(REC1,U,10)
+36 SET XNEW=$$GET1^DIQ(344.61,"1,",1.1,"I")
+37 ;
IF XNEW'=XOLD
Begin DoDot:1
+38 DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY TRI DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
End DoDot:1
+39 ;
+40 ; Maximum dollar amount to Auto-Decrease TRICARE claims
+41 SET XOLD=$PIECE(REC1,U,7)
+42 SET XNEW=$$GET1^DIQ(344.61,"1,",1.07,"I")
+43 IF XNEW'=XOLD
Begin DoDot:1
+44 DO LNOUT(.HEAD,.LINE,"AUTO-DECREASE TRI MAX AMT",XOLD,XNEW,"$",.COUNT)
End DoDot:1
+45 ;
+46 ; TRICARE EFT POST PREVENT DAYS - PRCA*4.5*332
+47 SET XOLD=$PIECE(REC0,U,13)
+48 SET XNEW=$$GET1^DIQ(344.61,"1,",.13,"I")
+49 IF XNEW'=XOLD
Begin DoDot:1
+50 DO LNOUT(.HEAD,.LINE,"TRICARE EFT POST PREVENT DAYS",XOLD,XNEW,"D",.COUNT)
End DoDot:1
+51 QUIT
+52 ;
PAYEXC(COUNT,LINE) ; Check for Payer Auto-Post and Auto-Decrease exclusions PRCA*4.5*345
+1 ;Input:
+2 ; COUNT: count of parameter changes
+3 ; LINE: Array of site parameter changes
+4 ; ^TMP($T(+0),$J,344.6): Original Payer exclusions
+5 ;Output:
+6 ; COUNT: Updated # of parameter changes
+7 ; LINE: Array of updated site parameter changes
+8 NEW IEN,REC0,XNEW,XOLD
+9 ;
+10 ; Check each payer in 344.6 for changes
+11 SET IEN=0
FOR
SET IEN=$ORDER(^RCY(344.6,IEN))
if 'IEN
QUIT
Begin DoDot:1
+12 SET REC0=$GET(^TMP($TEXT(+0),$JOB,344.6,IEN,0))
+13 SET HEAD=0
+14 ; PRCA*4.5*332
SET HEAD("DETAIL")=$$GET1^DIQ(344.6,IEN_",",.01,"E")
SET HEAD("TXT")="PAYER: "_HEAD("DETAIL")
+15 ; Exclude med claims posting
+16 SET XOLD=$PIECE(REC0,U,6)
SET XNEW=$$GET1^DIQ(344.6,IEN_",",.06,"I")
+17 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"EXCLUDE MED CLAIMS POSTING",XOLD,XNEW,"B",.COUNT)
+18 ;
+19 ; Exclude med claims decrease
+20 SET XOLD=$PIECE(REC0,U,7)
SET XNEW=$$GET1^DIQ(344.6,IEN_",",.07,"I")
+21 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"EXCLUDE MED CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT)
+22 ;
+23 ; Exclude Rx claim posting
+24 SET XOLD=$PIECE(REC0,U,8)
SET XNEW=$$GET1^DIQ(344.6,IEN_",",.08,"I")
+25 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"EXCLUDE RX CLAIM POSTING",XOLD,XNEW,"B",.COUNT)
+26 ;
+27 ; Exclude Rx claims decrease
+28 SET XOLD=$PIECE(REC0,U,12)
SET XNEW=$$GET1^DIQ(344.6,IEN_",",.12,"I")
+29 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"EXCLUDE RX CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT)
+30 ;
+31 ; PRCA*4.5*349 - Begin modified block
+32 ; Exclude TRICARE claims posting
+33 SET XOLD=$PIECE(REC0,U,13)
SET XNEW=$$GET1^DIQ(344.6,IEN_",",.13,"I")
+34 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"EXCLUDE TRICARE CLAIMS POSTING",XOLD,XNEW,"B",.COUNT)
+35 ;
+36 ; Exclude TRICARE claims decrease
+37 SET XOLD=$PIECE(REC0,U,14)
SET XNEW=$$GET1^DIQ(344.6,IEN_",",.14,"I")
+38 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"EXCLUDE TRICARE CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT)
+39 ; PRCA*4.5*349 - End modified block
End DoDot:1
+40 QUIT
+41 ;
CARCHNG(COUNT,LINE) ; Check for CARC-RARC parameter changes
+1 ; PRCA*4.5*345 - New method
+2 ;Input, passed by reference:
+3 ; COUNT: # of parameter changes
+4 ; LINE: array of site parameter changes
+5 ; ^TMP($T(+0),$J,344.62): Original CARC-RARC values
+6 ;Output:
+7 ; COUNT: updated # of parameter changes
+8 ; LINE: updated array
+9 NEW IEN,REC,XNEW,XOLD
+10 ;
+11 ; Check entries in 344.62 for changes
+12 SET IEN=0
FOR
SET IEN=$ORDER(^RCY(344.62,IEN))
if 'IEN
QUIT
Begin DoDot:1
+13 SET REC(0)=$GET(^TMP($TEXT(+0),$JOB,344.62,IEN,0))
+14 SET REC(1)=$GET(^TMP($TEXT(+0),$JOB,344.62,IEN,1))
+15 SET REC(2)=$GET(^TMP($TEXT(+0),$JOB,344.62,IEN,2))
+16 ; PRCA*3.4*349 TRICARE Auto-Decrease
SET REC(3)=$GET(^TMP($TEXT(+0),$JOB,344.62,IEN,3))
+17 SET HEAD=0
+18 ; PRCA*4.5*332
SET HEAD("DETAIL")=$$GET1^DIQ(344.62,IEN_",",.01,"E")
+19 SET HEAD("TXT")="CARC/RARC CODE: "_HEAD("DETAIL")
+20 ;
+21 ; PRCA*4.5*345 - Changed descriptions below
+22 ; CARC Medical Claims w/Payments Auto-Decrease
+23 SET XOLD=$PIECE(REC(0),U,2)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",.02,"I")
+24 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC MED PAY AUTO-DECREASE",XOLD,XNEW,"B",.COUNT)
+25 ; CARC Medical Claims w/Payments Auto-Decrease amount
+26 SET XOLD=$PIECE(REC(0),U,6)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",.06,"I")
+27 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC MED PAY DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT)
+28 ; CARC Medical Claims w/No Payments Auto-Decrease
+29 SET XOLD=$PIECE(REC(1),U,1)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",.08,"I")
+30 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC AUTO-DECREASE MED NO-PAY",XOLD,XNEW,"B",.COUNT)
+31 ; CARC Medical Claims w/No Payments Auto-Decrease amount
+32 SET XOLD=$PIECE(REC(1),U,5)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",.12,"I")
+33 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC DECREASE AMOUNT MED NO-PAY",XOLD,XNEW,"$",.COUNT)
+34 ; CARC Rx w/Payments Auto-Decrease
+35 SET XOLD=$PIECE(REC(2),U,1)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",2.01,"I")
+36 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC RX PAY AUTO-DECREASE",XOLD,XNEW,"B",.COUNT)
+37 ; CARC Rx w/Payments Auto-Decrease amount
+38 SET XOLD=$PIECE(REC(2),U,5)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",2.05,"I")
+39 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC RX PAY DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT)
+40 ; PRCA*4.5*349 - Begin Modified Block
+41 ; CARC TRICARE w/Payments Auto-Decrease
+42 SET XOLD=$PIECE(REC(3),U,1)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",3.01,"I")
+43 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC TRICARE PAY AUTO-DECREASE",XOLD,XNEW,"B",.COUNT)
+44 ; CARC TRICARE w/Payments Auto-Decrease amount
+45 SET XOLD=$PIECE(REC(3),U,5)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",3.05,"I")
+46 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC TRICARE PAY DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT)
+47 ; CARC TRICARE w/No Payments Auto-Decrease
+48 SET XOLD=$PIECE(REC(3),U,7)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",3.07,"I")
+49 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC TRICARE AUTO-DECREASE NO-PAY",XOLD,XNEW,"B",.COUNT)
+50 ; CARC TRICARE w/No Payments Auto-Decrease amount
+51 SET XOLD=$PIECE(REC(3),U,11)
SET XNEW=$$GET1^DIQ(344.62,IEN_",",3.11,"I")
+52 IF XOLD'=XNEW
DO LNOUT(.HEAD,.LINE,"CARC TRICARE DECREASE AMOUNT NO-PAY",XOLD,XNEW,"$",.COUNT)
+53 ; PRCA*4.5*349 - End Modified Block
End DoDot:1
+54 QUIT
+55 ;
LNOUT(HEAD,LINE,TXT,XOLD,XNEW,TYPE,COUNT) ; Format a line for the message
+1 ; PRCA*4.5*345 - Added parameter documentation
+2 ;Input: HEAD: 0 if header not output into the line array for this section yet, 1 otherwise
+3 ; HEAD("SIZE"): 10
+4 ; LINE: array with parameter changes for the current section
+5 ; TXT: Description of the changed field
+6 ; XOLD: Old Value (Internal format)
+7 ; XNEW: New Value (Internal Format)
+8 ; TYPE: "B" - Boolean, "$" - Dollar amount, "D" - Days, "T" - Text
+9 ; COUNT: count of changes
+10 ;Output: HEAD: 1 if it came in as 0
+11 ; LINE: Updated array of lines detail parameter changes for the current section
+12 ; COUNT: Updated # of changes
+13 ;
+14 NEW DOTS,RCFDA,RCIENS,Y
+15 SET DOTS=$TRANSLATE($JUSTIFY(" ",50)," ",".")
+16 ;
+17 ; Output header for this section if not done
+18 IF 'HEAD
SET COUNT=COUNT+1
SET LINE(COUNT+HEAD("SIZE"))=HEAD("TXT")
SET HEAD=1
+19 ;
+20 SET Y=$EXTRACT(" "_TXT_" "_DOTS,1,50)_$JUSTIFY($$FRMT(XOLD,TYPE),10)_" "_$JUSTIFY($$FRMT(XNEW,TYPE),10)
+21 SET COUNT=COUNT+1
SET LINE(COUNT+HEAD("SIZE"))=Y
+22 ;
+23 ;PRCA*4.5*332 save changes into multiple 344.611 for history report
+24 SET RCIENS="+1,1,"
+25 SET RCFDA(344.611,RCIENS,.01)=$$NOW^XLFDT
+26 SET RCFDA(344.611,RCIENS,.02)=DUZ
+27 SET RCFDA(344.611,RCIENS,1)=TXT
+28 SET RCFDA(344.611,RCIENS,2)=HEAD("DETAIL")
+29 SET RCFDA(344.611,RCIENS,3)=$$FRMT(XOLD,TYPE)
+30 SET RCFDA(344.611,RCIENS,4)=$$FRMT(XNEW,TYPE)
+31 DO UPDATE^DIE("","RCFDA","RCIENS")
+32 QUIT
+33 ;
FRMT(VAL,TP) ;function, format value, added PRCA*4.5*332
+1 ; Input: VAL - Value to be formatted
+2 ; TP - "$" - Dollar amount, B - Boolean, D - Days
+3 ; Returns formatted value
+4 NEW RTRN
SET RTRN=VAL
+5 if TP="B"
SET RTRN=$SELECT(VAL:"Yes",1:"No")
+6 if TP="$"
SET RTRN="$"_$FNUMBER(VAL,",")
+7 QUIT RTRN
+8 ;
PAYEN ; save snapshot of file 344.6, added PRCA*4.5*332
+1 ; Input: None
+2 ; Output: ^TMP($T(+0),$J) created by merging in files 344.6, 344.61 and 344.62
+3 KILL ^TMP($TEXT(+0),$JOB)
+4 ; Save payer exclusions
MERGE ^TMP($TEXT(+0),$JOB,344.6)=^RCY(344.6)
+5 QUIT
+6 ;
PAYEX ; (EN) On exit from identify payers option, compare snapshot with live files. - Added for PRCA*4.5*332
+1 ; Save changes to the parameter audit multiple 344.611
+2 ; Input: ^TMP($T(+0),$J) created above by merging in file 344.6
+3 ; Output: Enties in multiple 344.611 to keep history of payer flag changes
+4 ;
+5 NEW COUNT,HEAD,IEN,LINE,REC0,XNEW,XOLD
+6 ;
+7 SET HEAD=0
SET HEAD("SIZE")=10
SET COUNT=0
+8 ; Check each payer in 344.6 for changes
+9 SET IEN=0
+10 ;
FOR
SET IEN=$ORDER(^RCY(344.6,IEN))
if 'IEN
QUIT
Begin DoDot:1
+11 SET REC0=$GET(^TMP($TEXT(+0),$JOB,344.6,IEN,0))
+12 SET HEAD("DETAIL")=$$GET1^DIQ(344.6,IEN_",",.01,"E")
SET HEAD("TXT")="PAYER: "_HEAD("DETAIL")
+13 ; Pharmacy Flag
+14 SET XOLD=$PIECE(REC0,U,9)
SET XNEW=$$GET1^DIQ(344.6,IEN_",",.09,"I")
+15 IF (+XOLD)'=(+XNEW)
DO LNOUT(.HEAD,.LINE,"PHARMACY FLAG",XOLD,XNEW,"B",.COUNT)
+16 ; Tricare flag
+17 SET XOLD=$PIECE(REC0,U,10)
SET XNEW=$$GET1^DIQ(344.6,IEN_",",.1,"I")
+18 IF (+XOLD)'=(+XNEW)
DO LNOUT(.HEAD,.LINE,"TRICARE FLAG",XOLD,XNEW,"B",.COUNT)
End DoDot:1
+19 QUIT
+20 ;
