Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDPESP6

RCDPESP6.m

Go to the documentation of this file.
  1. RCDPESP6 ;AITC/CJE - ePayment Lockbox Site Parameters - Notify Changes;29 Jan 2019 18:00:14
  1. ;;4.5;Accounts Receivable;**326,332,345,349,424,432**;;Build 16
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. EN ; EP from RCDPESP
  1. ; On entry into parameter edit, save a snapshot of the files
  1. ; Input: None
  1. ; Output: ^TMP("RCDPESP6",$J) for files 344.6, 344.61 and 344.62
  1. K ^TMP("RCDPESP6",$J)
  1. M ^TMP("RCDPESP6",$J,344.6)=^RCY(344.6) ; RCDPE AUTO-PAY EXCLUSION
  1. M ^TMP("RCDPESP6",$J,344.61)=^RCY(344.61) ; RCDPE PARAMETER
  1. M ^TMP("RCDPESP6",$J,344.62)=^RCY(344.62) ; RCDPE CARC-RARC AUTO DEC
  1. Q
  1. ;
  1. EXIT ; EP from RCDPESP
  1. ; On exit compare snapshots with files
  1. ; sends mail message if any designated items have changed.
  1. ; Input: ^TMP($T(+0),$J) copies of files 344.6, 344.61 and 344.62
  1. ; Output: Mail message (if any parameters have changed)
  1. ;
  1. N C,CHANGES,CHGCNT,G,LINES,RCMSGTXT,RCSITE,RCSUBJ,TXTLNS,XMINSTR,XMTO
  1. ;Check for changed parameters, if no changes, don't send message
  1. S CHGCNT=$$CHKCHNG(.RCMSGTXT) ; Check for any changes in parameters ;
  1. Q:'CHGCNT ; No changes made so don't send message
  1. ;
  1. S RCSITE=$$SITE^VASITE()
  1. S RCSUBJ=$E("ePayments EDI Lockbox Parameters changed "_$P(RCSITE,U,2),1,65)
  1. D HEADER(.RCMSGTXT,RCSITE)
  1. ;
  1. S XMINSTR("FROM")="POSTMASTER",XMTO(DUZ)="",XMTO("G.RCDPE AUDIT")=""
  1. K ^TMP("XMERR",$J)
  1. D SENDMSG^XMXAPI(DUZ,RCSUBJ,"RCMSGTXT",.XMTO,.XMINSTR)
  1. ;
  1. I $D(^TMP("XMERR",$J)) D
  1. . D MES^XPDUTL("MailMan returned an error.")
  1. . D MES^XPDUTL("The error text is:")
  1. . S G=$NA(^TMP("XMERR",$J))
  1. . F S G=$Q(@G) Q:G="" Q:$QS(G,2)'=$J D MES^XPDUTL(" "_$C(34)_@G_$C(34))
  1. . D MES^XPDUTL(" * End of Error Text *")
  1. . K ^TMP("XMERR",$J)
  1. ;
  1. K ^TMP("RCDPESP6",$J) ; Clean up
  1. Q
  1. ;
  1. ; PRCA*4.5*349 - Re-write subroutine
  1. ; Output: Array MSGTXT passed by reference
  1. ; limit subject to 65 chars.
  1. S MSGTXT(1)=" "
  1. S MSGTXT(2)=" Site: "_$P(RCSITE,U,2)
  1. S MSGTXT(3)=" Station # "_$P(RCSITE,U,3)
  1. S MSGTXT(4)=" Domain: "_$G(^XMB("NETNAME"))
  1. S MSGTXT(5)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"1ZPM")
  1. S MSGTXT(6)=" User: "_$P($G(^VA(200,DUZ,0)),U)
  1. S MSGTXT(7)=" "
  1. S MSGTXT(8)=" The following EDI Lockbox Site Parameters were changed: "
  1. S MSGTXT(9)=" "
  1. S MSGTXT(10)=$J("",50)_$J("OLD VALUE",10)_" "_$J("NEW VALUE",10)
  1. Q
  1. ;
  1. CHKCHNG(LINE) ;function, check for changes in EDI Lockbox site parameters
  1. ; PRCA*4.5*345 - Added checks for Auto-Decrease Rx/TRICARE parameters
  1. ; Input:
  1. ; ^TMP($T(+0),$J): Copies of file 344.6, 344.61 and 344.62 taken on entry
  1. ;Output:
  1. ; LINE: Change for mail message, Passed by reference
  1. ; Returns number of changes
  1. N COUNT,HEAD,REC0,REC1,REC2,XNEW,XOLD
  1. S (COUNT,HEAD)=0,HEAD("SIZE")=10
  1. S HEAD("TXT")="ALL PAYERS",HEAD("DETAIL")=""
  1. ;
  1. ; Check parameters in 344.61 that apply to all payers
  1. ; PRCA*4.5*345 added new subroutines
  1. D MEDCHNG(.HEAD,.COUNT,.LINE) ; Medical parameter changes
  1. D RXCHNG(.HEAD,.COUNT,.LINE) ; Pharmacy parameter changes
  1. D TRICHNG(.HEAD,.COUNT,.LINE) ; PRCA*4.5*349 - Check for TRICARE parameter changes
  1. D ZERCHNG(.COUNT,.LINE) ; Zero Payment ERA parameter changes PRCA*4.5*424
  1. D PAYEXC(.COUNT,.LINE) ; Payer exclusions parameter changes
  1. D CARCHNG(.COUNT,.LINE) ; CARC-RARC parameter changes
  1. Q COUNT
  1. ;
  1. MEDCHNG(HEAD,COUNT,LINE) ; Check for Medical site parameter changes - PRCA*4.5*345
  1. ;these parameters passed by reference:
  1. ; HEAD: See LNOUT for details
  1. ; COUNT: count of parameter changes
  1. ; LINE: Array of site parameter changes
  1. N MEDND,XNEW,XOLD
  1. S MEDND=^TMP($T(+0),$J,344.61,1,0)
  1. ; Auto-post med claims enabled
  1. S XOLD=$P(MEDND,U,2),XNEW=$$GET1^DIQ(344.61,"1,",.02,"I")
  1. I XNEW'=XOLD D
  1. . D LNOUT(.HEAD,.LINE,"AUTO-POST MED CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT)
  1. ;
  1. ; Auto-decrease med enabled
  1. S XOLD=$P(MEDND,U,3),XNEW=$$GET1^DIQ(344.61,"1,",.03,"I")
  1. I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE MED ENABLED",XOLD,XNEW,"B",.COUNT)
  1. ;
  1. ; Auto-decrease med days
  1. S XOLD=$P(MEDND,U,4),XNEW=$$GET1^DIQ(344.61,"1,",.04,"I")
  1. I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
  1. ;
  1. ; Auto-decrease no-pay med enabled
  1. S XOLD=$P(MEDND,U,11),XNEW=$$GET1^DIQ(344.61,"1,",.11,"I")
  1. I XNEW'=XOLD D ;
  1. . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY MED ENABLED",XOLD,XNEW,"B",.COUNT)
  1. ;
  1. ; Auto-decrease no-pay med days
  1. S XOLD=$P(MEDND,U,12),XNEW=$$GET1^DIQ(344.61,"1,",.12,"I")
  1. I XNEW'=XOLD D ;
  1. . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
  1. ;
  1. ; Maximum dollar amount to Auto-Decrease medical claims
  1. S XOLD=$P(MEDND,U,5),XNEW=$$GET1^DIQ(344.61,"1,",.05,"I")
  1. I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE MED MAX AMT",XOLD,XNEW,"$",.COUNT)
  1. Q
  1. ;
  1. RXCHNG(HEAD,COUNT,LINE) ; Check for Rx site parameter changes PRCA*4.5*345
  1. ;these parameters passed by reference:
  1. ; HEAD: See LNOUT for details
  1. ; COUNT: count of parameter changes
  1. ; LINE: Array of site parameter changes
  1. N RXND,XNEW,XOLD
  1. S RXND=$G(^TMP($T(+0),$J,344.61,1,1))
  1. ; Auto-Post Rx
  1. S XOLD=$P(RXND,U,1),XNEW=$$GET1^DIQ(344.61,"1,",1.01,"I")
  1. I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-POST RX CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT)
  1. ;
  1. ; Auto-Decrease Rx enabled
  1. S XOLD=$P(RXND,U,2),XNEW=$$GET1^DIQ(344.61,"1,",1.02,"I")
  1. I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX ENABLED",XOLD,XNEW,"B",.COUNT)
  1. ;
  1. ; Auto-decrease Rx days
  1. S XOLD=$P(RXND,U,3),XNEW=$$GET1^DIQ(344.61,"1,",1.03,"I")
  1. I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
  1. ;
  1. ; Maximum dollar amount to Auto-Decrease Rx claims
  1. S XOLD=$P(RXND,U,4),XNEW=$$GET1^DIQ(344.61,"1,",1.04,"I")
  1. I XNEW'=XOLD D LNOUT(.HEAD,.LINE,"AUTO-DECREASE RX MAX AMT",XOLD,XNEW,"$",.COUNT)
  1. Q
  1. ;
  1. ; PRCA*4.5*349 - Subroutine re-written
  1. TRICHNG(HEAD,COUNT,LINE) ; Check for TRICARE site parameter changes
  1. ; Input: HEAD - See subroutine LNOUT for details
  1. ; COUNT - Current # of parameter changes
  1. ; LINE - Array of current site parameter changes
  1. ; Output: COUNT - Updated # of parameter changes
  1. ; LINE - Array of updated site parameter changes
  1. ;
  1. N REC0,REC1,XNEW,XOLD
  1. S REC0=^TMP("RCDPESP6",$J,344.61,1,0) ; Original Site parameters
  1. S REC1=^TMP("RCDPESP6",$J,344.61,1,1)
  1. ; Auto-post TRICARE claims enabled
  1. S XOLD=$P(REC1,U,5)
  1. S XNEW=$$GET1^DIQ(344.61,"1,",1.05,"I")
  1. I XNEW'=XOLD D
  1. . D LNOUT(.HEAD,.LINE,"AUTO-POST TRI CLAIMS ENABLED",XOLD,XNEW,"B",.COUNT)
  1. ;
  1. ; Auto-decrease TRICARE enabled
  1. S XOLD=$P(REC1,U,6)
  1. S XNEW=$$GET1^DIQ(344.61,"1,",1.06,"I")
  1. I XNEW'=XOLD D
  1. . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE TRI ENABLED",XOLD,XNEW,"B",.COUNT)
  1. ;
  1. ; Auto-decrease TRICARE days
  1. S XOLD=$P(REC1,U,8)
  1. S XNEW=$$GET1^DIQ(344.61,"1,",1.08,"I")
  1. I XNEW'=XOLD D
  1. . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE TRI DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
  1. ;
  1. ; Auto-decrease no-pay TRICARE enabled
  1. S XOLD=$P(REC1,U,9)
  1. S XNEW=$$GET1^DIQ(344.61,"1,",1.09,"I")
  1. I XNEW'=XOLD D ;
  1. . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY TRI ENABLED",XOLD,XNEW,"B",.COUNT)
  1. ;
  1. ; Auto-decrease no-pay TRICARE days
  1. S XOLD=$P(REC1,U,10)
  1. S XNEW=$$GET1^DIQ(344.61,"1,",1.1,"I")
  1. I XNEW'=XOLD D ;
  1. . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE NO-PAY TRI DAYS DEFAULT",XOLD,XNEW,"D",.COUNT)
  1. ;
  1. ; Maximum dollar amount to Auto-Decrease TRICARE claims
  1. S XOLD=$P(REC1,U,7)
  1. S XNEW=$$GET1^DIQ(344.61,"1,",1.07,"I")
  1. I XNEW'=XOLD D
  1. . D LNOUT(.HEAD,.LINE,"AUTO-DECREASE TRI MAX AMT",XOLD,XNEW,"$",.COUNT)
  1. ;
  1. ; TRICARE EFT POST PREVENT DAYS - PRCA*4.5*332
  1. S XOLD=$P(REC0,U,13)
  1. S XNEW=$$GET1^DIQ(344.61,"1,",.13,"I")
  1. I XNEW'=XOLD D
  1. . D LNOUT(.HEAD,.LINE,"TRICARE EFT POST PREVENT DAYS",XOLD,XNEW,"D",.COUNT)
  1. Q
  1. ;
  1. PAYEXC(COUNT,LINE) ; Check for Payer Auto-Post and Auto-Decrease exclusions PRCA*4.5*345
  1. ;Input:
  1. ; COUNT: count of parameter changes
  1. ; LINE: Array of site parameter changes
  1. ; ^TMP($T(+0),$J,344.6): Original Payer exclusions
  1. ;Output:
  1. ; COUNT: Updated # of parameter changes
  1. ; LINE: Array of updated site parameter changes
  1. N IEN,REC0,XNEW,XOLD
  1. ;
  1. ; Check each payer in 344.6 for changes
  1. S IEN=0 F S IEN=$O(^RCY(344.6,IEN)) Q:'IEN D
  1. . S REC0=$G(^TMP($T(+0),$J,344.6,IEN,0))
  1. . S HEAD=0
  1. . S HEAD("DETAIL")=$$GET1^DIQ(344.6,IEN_",",.01,"E"),HEAD("TXT")="PAYER: "_HEAD("DETAIL") ; PRCA*4.5*332
  1. . ; Exclude med claims posting
  1. . S XOLD=$P(REC0,U,6),XNEW=$$GET1^DIQ(344.6,IEN_",",.06,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE MED CLAIMS POSTING",XOLD,XNEW,"B",.COUNT)
  1. . ;
  1. . ; Exclude med claims decrease
  1. . S XOLD=$P(REC0,U,7),XNEW=$$GET1^DIQ(344.6,IEN_",",.07,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE MED CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT)
  1. . ;
  1. . ; Exclude Rx claim posting
  1. . S XOLD=$P(REC0,U,8),XNEW=$$GET1^DIQ(344.6,IEN_",",.08,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE RX CLAIM POSTING",XOLD,XNEW,"B",.COUNT)
  1. . ;
  1. . ; Exclude Rx claims decrease
  1. . S XOLD=$P(REC0,U,12),XNEW=$$GET1^DIQ(344.6,IEN_",",.12,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE RX CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT)
  1. . ;
  1. . ; PRCA*4.5*349 - Begin modified block
  1. . ; Exclude TRICARE claims posting
  1. . S XOLD=$P(REC0,U,13),XNEW=$$GET1^DIQ(344.6,IEN_",",.13,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE TRICARE CLAIMS POSTING",XOLD,XNEW,"B",.COUNT)
  1. . ;
  1. . ; Exclude TRICARE claims decrease
  1. . S XOLD=$P(REC0,U,14),XNEW=$$GET1^DIQ(344.6,IEN_",",.14,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"EXCLUDE TRICARE CLAIMS DECREASE",XOLD,XNEW,"B",.COUNT)
  1. . ; PRCA*4.5*349 - End modified block
  1. Q
  1. ;
  1. CARCHNG(COUNT,LINE) ; Check for CARC-RARC parameter changes
  1. ; PRCA*4.5*345 - New method
  1. ;Input, passed by reference:
  1. ; COUNT: # of parameter changes
  1. ; LINE: array of site parameter changes
  1. ; ^TMP($T(+0),$J,344.62): Original CARC-RARC values
  1. ;Output:
  1. ; COUNT: updated # of parameter changes
  1. ; LINE: updated array
  1. N IEN,REC,XNEW,XOLD
  1. ;
  1. ; Check entries in 344.62 for changes
  1. S IEN=0 F S IEN=$O(^RCY(344.62,IEN)) Q:'IEN D
  1. . S REC(0)=$G(^TMP($T(+0),$J,344.62,IEN,0))
  1. . S REC(1)=$G(^TMP($T(+0),$J,344.62,IEN,1))
  1. . S REC(2)=$G(^TMP($T(+0),$J,344.62,IEN,2))
  1. . S REC(3)=$G(^TMP($T(+0),$J,344.62,IEN,3)) ; PRCA*3.4*349 TRICARE Auto-Decrease
  1. . S HEAD=0
  1. . S HEAD("DETAIL")=$$GET1^DIQ(344.62,IEN_",",.01,"E") ; PRCA*4.5*332
  1. . S HEAD("TXT")="CARC/RARC CODE: "_HEAD("DETAIL")
  1. . ;
  1. . ; PRCA*4.5*345 - Changed descriptions below
  1. . ; CARC Medical Claims w/Payments Auto-Decrease
  1. . S XOLD=$P(REC(0),U,2),XNEW=$$GET1^DIQ(344.62,IEN_",",.02,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC MED PAY AUTO-DECREASE",XOLD,XNEW,"B",.COUNT)
  1. . ; CARC Medical Claims w/Payments Auto-Decrease amount
  1. . S XOLD=$P(REC(0),U,6),XNEW=$$GET1^DIQ(344.62,IEN_",",.06,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC MED PAY DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT)
  1. . ; CARC Medical Claims w/No Payments Auto-Decrease
  1. . S XOLD=$P(REC(1),U,1),XNEW=$$GET1^DIQ(344.62,IEN_",",.08,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC AUTO-DECREASE MED NO-PAY",XOLD,XNEW,"B",.COUNT)
  1. . ; CARC Medical Claims w/No Payments Auto-Decrease amount
  1. . S XOLD=$P(REC(1),U,5),XNEW=$$GET1^DIQ(344.62,IEN_",",.12,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC DECREASE AMOUNT MED NO-PAY",XOLD,XNEW,"$",.COUNT)
  1. . ; CARC Rx w/Payments Auto-Decrease
  1. . S XOLD=$P(REC(2),U,1),XNEW=$$GET1^DIQ(344.62,IEN_",",2.01,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC RX PAY AUTO-DECREASE",XOLD,XNEW,"B",.COUNT)
  1. . ; CARC Rx w/Payments Auto-Decrease amount
  1. . S XOLD=$P(REC(2),U,5),XNEW=$$GET1^DIQ(344.62,IEN_",",2.05,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC RX PAY DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT)
  1. . ; PRCA*4.5*349 - Begin Modified Block
  1. . ; CARC TRICARE w/Payments Auto-Decrease
  1. . S XOLD=$P(REC(3),U,1),XNEW=$$GET1^DIQ(344.62,IEN_",",3.01,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC TRICARE PAY AUTO-DECREASE",XOLD,XNEW,"B",.COUNT)
  1. . ; CARC TRICARE w/Payments Auto-Decrease amount
  1. . S XOLD=$P(REC(3),U,5),XNEW=$$GET1^DIQ(344.62,IEN_",",3.05,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC TRICARE PAY DECREASE AMOUNT",XOLD,XNEW,"$",.COUNT)
  1. . ; CARC TRICARE w/No Payments Auto-Decrease
  1. . S XOLD=$P(REC(3),U,7),XNEW=$$GET1^DIQ(344.62,IEN_",",3.07,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC TRICARE AUTO-DECREASE NO-PAY",XOLD,XNEW,"B",.COUNT)
  1. . ; CARC TRICARE w/No Payments Auto-Decrease amount
  1. . S XOLD=$P(REC(3),U,11),XNEW=$$GET1^DIQ(344.62,IEN_",",3.11,"I")
  1. . I XOLD'=XNEW D LNOUT(.HEAD,.LINE,"CARC TRICARE DECREASE AMOUNT NO-PAY",XOLD,XNEW,"$",.COUNT)
  1. . ; PRCA*4.5*349 - End Modified Block
  1. Q
  1. ;
  1. ; PRCA*4.5*424 - Subroutine added
  1. ZERCHNG(COUNT,LINE) ; Check for TRICARE site parameter changes
  1. ; Input: COUNT - Current # of parameter changes
  1. ; LINE - Array of current site parameter changes
  1. ; Output: COUNT - Updated # of parameter changes
  1. ; LINE - Array of updated site parameter changes
  1. ;
  1. N REC0,REC1,XNEW,XOLD
  1. S REC1=^TMP("RCDPESP6",$J,344.61,1,1)
  1. S XOLD=+$P(REC1,"^",11)
  1. S XNEW=$$GET1^DIQ(344.61,"1,",1.11,"I")
  1. I XNEW'=XOLD D ;
  1. . D LNOUT(.HEAD,.LINE,"AUTO-POST ZERO PAY ERAs ENABLED",XOLD,XNEW,"B",.COUNT)
  1. . I XNEW D ; Enabling auto post of zero pay triggers process to post historical ERAs
  1. . . N ZTDESC,ZTRTN,ZTSAVE,ZTSK
  1. . . S ZTRTN="ZEROPOST^RCDPESP8"
  1. . . S ZTDESC="AUTO POST HISTORIC ZERO PAY ERAs"
  1. . . S ZTIO=""
  1. . . S ZTDTH=$$NOW^XLFDT()
  1. . . S ZTPRI=1 ; Set as low priority
  1. . . D ^%ZTLOAD
  1. . . I $D(ZTSK) W !!,"Task number "_ZTSK_" was queued to auto-post historic zero payment ERAs" H 3
  1. . . E W !!,"Unable to queue auto post of historic zero pay ERAs." H 3
  1. . . K IO("Q")
  1. . . D HOME^%ZIS
  1. Q
  1. ;
  1. LNOUT(HEAD,LINE,TXT,XOLD,XNEW,TYPE,COUNT) ; Format a line for the message
  1. ; PRCA*4.5*345 - Added parameter documentation
  1. ;Input: HEAD: 0 if header not output into the line array for this section yet, 1 otherwise
  1. ; HEAD("SIZE"): 10
  1. ; LINE: array with parameter changes for the current section
  1. ; TXT: Description of the changed field
  1. ; XOLD: Old Value (Internal format)
  1. ; XNEW: New Value (Internal Format)
  1. ; TYPE: "B" - Boolean, "$" - Dollar amount, "D" - Days, "T" - Text
  1. ; COUNT: count of changes
  1. ;Output: HEAD: 1 if it came in as 0
  1. ; LINE: Updated array of lines detail parameter changes for the current section
  1. ; COUNT: Updated # of changes
  1. ;
  1. N DOTS,RCFDA,RCIENS,Y
  1. S DOTS=$TR($J(" ",50)," ",".")
  1. ;
  1. ; Output header for this section if not done
  1. I 'HEAD S COUNT=COUNT+1,LINE(COUNT+HEAD("SIZE"))=HEAD("TXT"),HEAD=1
  1. ;
  1. S Y=$E(" "_TXT_" "_DOTS,1,50)_$J($$FRMT(XOLD,TYPE),10)_" "_$J($$FRMT(XNEW,TYPE),10)
  1. S COUNT=COUNT+1,LINE(COUNT+HEAD("SIZE"))=Y
  1. ;
  1. ;PRCA*4.5*332 save changes into multiple 344.611 for history report
  1. S RCIENS="+1,1,"
  1. S RCFDA(344.611,RCIENS,.01)=$$NOW^XLFDT
  1. S RCFDA(344.611,RCIENS,.02)=DUZ
  1. S RCFDA(344.611,RCIENS,1)=TXT
  1. S RCFDA(344.611,RCIENS,2)=HEAD("DETAIL")
  1. S RCFDA(344.611,RCIENS,3)=$$FRMT(XOLD,TYPE)
  1. S RCFDA(344.611,RCIENS,4)=$$FRMT(XNEW,TYPE)
  1. D UPDATE^DIE("","RCFDA","RCIENS")
  1. Q
  1. ;
  1. FRMT(VAL,TP) ;function, format value, added PRCA*4.5*332
  1. ; Input: VAL - Value to be formatted
  1. ; TP - "$" - Dollar amount, B - Boolean, D - Days
  1. ; Returns formatted value
  1. N RTRN S RTRN=VAL
  1. S:TP="B" RTRN=$S(VAL:"Yes",1:"No")
  1. S:TP="$" RTRN="$"_$FN(VAL,",")
  1. Q RTRN
  1. ;
  1. PAYEN ; save snapshot of file 344.6, added PRCA*4.5*332
  1. ; Input: None
  1. ; Output: ^TMP($T(+0),$J) created by merging in files 344.6, 344.61 and 344.62
  1. K ^TMP($T(+0),$J)
  1. M ^TMP($T(+0),$J,344.6)=^RCY(344.6) ; Save payer exclusions
  1. Q
  1. ;
  1. 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
  1. ; Input: ^TMP($T(+0),$J) created above by merging in file 344.6
  1. ; Output: Enties in multiple 344.611 to keep history of payer flag changes
  1. ;
  1. N COUNT,HEAD,IEN,LINE,REC0,XNEW,XOLD
  1. ;
  1. S HEAD=0,HEAD("SIZE")=10,COUNT=0
  1. ; Check each payer in 344.6 for changes
  1. S IEN=0
  1. F S IEN=$O(^RCY(344.6,IEN)) Q:'IEN D ;
  1. . S REC0=$G(^TMP($T(+0),$J,344.6,IEN,0))
  1. . S HEAD("DETAIL")=$$GET1^DIQ(344.6,IEN_",",.01,"E"),HEAD("TXT")="PAYER: "_HEAD("DETAIL")
  1. . ; Pharmacy Flag
  1. . S XOLD=$P(REC0,U,9),XNEW=$$GET1^DIQ(344.6,IEN_",",.09,"I")
  1. . I (+XOLD)'=(+XNEW) D LNOUT(.HEAD,.LINE,"PHARMACY FLAG",XOLD,XNEW,"B",.COUNT)
  1. . ; Tricare flag
  1. . S XOLD=$P(REC0,U,10),XNEW=$$GET1^DIQ(344.6,IEN_",",.1,"I")
  1. . I (+XOLD)'=(+XNEW) D LNOUT(.HEAD,.LINE,"TRICARE FLAG",XOLD,XNEW,"B",.COUNT)
  1. . ; CHAMPVA flag PRCA*4.5*432
  1. . S XOLD=$P(REC0,U,10),XNEW=$$GET1^DIQ(344.6,IEN_",",.15,"I")
  1. . I (+XOLD)'=(+XNEW) D LNOUT(.HEAD,.LINE,"CHAMPVA FLAG",XOLD,XNEW,"B",.COUNT)
  1. Q
  1. ;