RCP332 ;AITC/CJE,hrubovcak - ePayment Lockbox Post-Installation Processing ;4 Oct 2018 10:29:18
;;4.5;Accounts Receivable;**332**;Oct 4, 2018;Build 40
;Per VA Directive 6402, this routine should not be modified.
Q
;
POST ;
N RCMSG,X,Y
D BMES^XPDUTL("PRCA*4.5*332 post-installation work "_$$HTE^XLFDT($H)) ; add date/time to log
;
;(#.13) TRICARE EFT POST PREVENT DAYS [13N] update is idempotent if value is in-bounds
S RCMSG="TRICARE EFT POST PREVENT DAYS" D ; RCMSG holds action performed
. S X(344.61,0)=$G(^RCY(344.61,1,0)),Y=$P(X(344.61,0),U,13),RCMSG("prev")=Y
. ; minimum is 14 days, maximum is 60
. I (Y>13)&(Y<61) S RCMSG=RCMSG_" value is "_Y_" days. No action taken." K RCMSG("prev") Q ; minimum is 14 days, maximum is 60
. L +^RCY(344.61,1):DILOCKTM E D Q ; exclusive access
.. S RCMSG="Error, unable to update "_RCMSG_" Cannot LOCK entry."
. ; set default to 30
. N RCFDA,RCFMERR
. S RCFDA(344.61,"1,",.13)=30 ; only 1 entry in 344.61
. D FILE^DIE("","RCFDA","RCFMERR")
. I $D(RCFMERR) D Q ; handle FileMan error
.. S RCMSG=RCMSG_" not updated due to error."
.. S X="RCFMERR" F S X=$Q(@X) Q:X="" S Y=@X D BMES^XPDUTL(Y) ; put error text into log
. S X(344.61,0)=$G(^RCY(344.61,1,0)),Y=+$P(X(344.61,0),U,13)
. L -^RCY(344.61,1) S RCMSG=RCMSG_" set to "_Y_" days."
;
K X,Y D BMES^XPDUTL(RCMSG)
D:$D(RCMSG("prev")) MES^XPDUTL("The previous value was "_$C(34)_RCMSG("prev")_$C(34)_".")
; end TRICARE EFT POST PREVENT DAYS update
;
; (#.07) PHARMACY EFT POST PREVENT DAYS [7N] update is idempotent if value null or in-bounds
K RCMSG
S RCMSG="PHARMACY EFT POST PREVENT DAYS" D ; RCMSG holds action performed
. S X(344.61,0)=$G(^RCY(344.61,1,0)),Y=$P(X(344.61,0),U,7),RCMSG("prev")=Y
. I Y="" S RCMSG=RCMSG_" value has not been entered. No action taken." Q ; field is null, nothing to do
. I (Y>20)&(Y<100) S RCMSG=RCMSG_" value is "_Y_" days. No action taken." K RCMSG("prev") Q ; minimum is 21 days, maximum is 99
. L +^RCY(344.61,1):DILOCKTM E D Q ; exclusive access
.. S RCMSG="Error, unable to update "_RCMSG_" Cannot LOCK entry."
. ; value is out-of-bounds, fix it
. N RCFDA,RCFMERR
. S RCFDA(344.61,"1,",.07)=$S(Y<21:21,1:99) ; only 1 entry in 344.61
. D FILE^DIE("","RCFDA","RCFMERR")
. I $D(RCFMERR) D Q ; handle FileMan error
.. S RCMSG=RCMSG_" not updated due to error."
.. S X="RCFMERR" F S X=$Q(@X) Q:X="" S Y=@X D BMES^XPDUTL(Y) ; put error text into log
. S X(344.61,0)=$G(^RCY(344.61,1,0)),Y=+$P(X(344.61,0),U,7)
. L -^RCY(344.61,1) S RCMSG=RCMSG_" set to "_Y_" days."
;
K X,Y D:$L(RCMSG) BMES^XPDUTL(RCMSG) ; if RCMSG null nothing was updated
D:$D(RCMSG("prev")) MES^XPDUTL("The previous value was "_$C(34)_RCMSG("prev")_$C(34)_".")
; end PHARMACY EFT POST PREVENT DAYS update
;
D BMES^XPDUTL("Fixing ERA numbers...")
D FIX3444
;
D BMES^XPDUTL("PRCA*4.5*332 post-installation finished "_$$HTE^XLFDT($H))
Q
;
;
FIX3444 ; Repair Internal Entry Numbers in 344.4 where IEN is not equal to .01
N IEN,ENTRY
S IEN=0
F S IEN=$O(^RCY(344.4,IEN)) Q:'IEN D ;
. S ENTRY=$P($G(^RCY(344.4,IEN,0)),"^",1)
. I 'ENTRY Q
. I ENTRY'=IEN D ;
. . N FDA
. . S FDA(344.4,IEN_",",.01)=IEN
. . D FILE^DIE("","FDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCP332 3287 printed Dec 13, 2024@01:47:17 Page 2
RCP332 ;AITC/CJE,hrubovcak - ePayment Lockbox Post-Installation Processing ;4 Oct 2018 10:29:18
+1 ;;4.5;Accounts Receivable;**332**;Oct 4, 2018;Build 40
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POST ;
+1 NEW RCMSG,X,Y
+2 ; add date/time to log
DO BMES^XPDUTL("PRCA*4.5*332 post-installation work "_$$HTE^XLFDT($HOROLOG))
+3 ;
+4 ;(#.13) TRICARE EFT POST PREVENT DAYS [13N] update is idempotent if value is in-bounds
+5 ; RCMSG holds action performed
SET RCMSG="TRICARE EFT POST PREVENT DAYS"
Begin DoDot:1
+6 SET X(344.61,0)=$GET(^RCY(344.61,1,0))
SET Y=$PIECE(X(344.61,0),U,13)
SET RCMSG("prev")=Y
+7 ; minimum is 14 days, maximum is 60
+8 ; minimum is 14 days, maximum is 60
IF (Y>13)&(Y<61)
SET RCMSG=RCMSG_" value is "_Y_" days. No action taken."
KILL RCMSG("prev")
QUIT
+9 ; exclusive access
LOCK +^RCY(344.61,1):DILOCKTM
IF '$TEST
Begin DoDot:2
+10 SET RCMSG="Error, unable to update "_RCMSG_" Cannot LOCK entry."
End DoDot:2
QUIT
+11 ; set default to 30
+12 NEW RCFDA,RCFMERR
+13 ; only 1 entry in 344.61
SET RCFDA(344.61,"1,",.13)=30
+14 DO FILE^DIE("","RCFDA","RCFMERR")
+15 ; handle FileMan error
IF $DATA(RCFMERR)
Begin DoDot:2
+16 SET RCMSG=RCMSG_" not updated due to error."
+17 ; put error text into log
SET X="RCFMERR"
FOR
SET X=$QUERY(@X)
if X=""
QUIT
SET Y=@X
DO BMES^XPDUTL(Y)
End DoDot:2
QUIT
+18 SET X(344.61,0)=$GET(^RCY(344.61,1,0))
SET Y=+$PIECE(X(344.61,0),U,13)
+19 LOCK -^RCY(344.61,1)
SET RCMSG=RCMSG_" set to "_Y_" days."
End DoDot:1
+20 ;
+21 KILL X,Y
DO BMES^XPDUTL(RCMSG)
+22 if $DATA(RCMSG("prev"))
DO MES^XPDUTL("The previous value was "_$CHAR(34)_RCMSG("prev")_$CHAR(34)_".")
+23 ; end TRICARE EFT POST PREVENT DAYS update
+24 ;
+25 ; (#.07) PHARMACY EFT POST PREVENT DAYS [7N] update is idempotent if value null or in-bounds
+26 KILL RCMSG
+27 ; RCMSG holds action performed
SET RCMSG="PHARMACY EFT POST PREVENT DAYS"
Begin DoDot:1
+28 SET X(344.61,0)=$GET(^RCY(344.61,1,0))
SET Y=$PIECE(X(344.61,0),U,7)
SET RCMSG("prev")=Y
+29 ; field is null, nothing to do
IF Y=""
SET RCMSG=RCMSG_" value has not been entered. No action taken."
QUIT
+30 ; minimum is 21 days, maximum is 99
IF (Y>20)&(Y<100)
SET RCMSG=RCMSG_" value is "_Y_" days. No action taken."
KILL RCMSG("prev")
QUIT
+31 ; exclusive access
LOCK +^RCY(344.61,1):DILOCKTM
IF '$TEST
Begin DoDot:2
+32 SET RCMSG="Error, unable to update "_RCMSG_" Cannot LOCK entry."
End DoDot:2
QUIT
+33 ; value is out-of-bounds, fix it
+34 NEW RCFDA,RCFMERR
+35 ; only 1 entry in 344.61
SET RCFDA(344.61,"1,",.07)=$SELECT(Y<21:21,1:99)
+36 DO FILE^DIE("","RCFDA","RCFMERR")
+37 ; handle FileMan error
IF $DATA(RCFMERR)
Begin DoDot:2
+38 SET RCMSG=RCMSG_" not updated due to error."
+39 ; put error text into log
SET X="RCFMERR"
FOR
SET X=$QUERY(@X)
if X=""
QUIT
SET Y=@X
DO BMES^XPDUTL(Y)
End DoDot:2
QUIT
+40 SET X(344.61,0)=$GET(^RCY(344.61,1,0))
SET Y=+$PIECE(X(344.61,0),U,7)
+41 LOCK -^RCY(344.61,1)
SET RCMSG=RCMSG_" set to "_Y_" days."
End DoDot:1
+42 ;
+43 ; if RCMSG null nothing was updated
KILL X,Y
if $LENGTH(RCMSG)
DO BMES^XPDUTL(RCMSG)
+44 if $DATA(RCMSG("prev"))
DO MES^XPDUTL("The previous value was "_$CHAR(34)_RCMSG("prev")_$CHAR(34)_".")
+45 ; end PHARMACY EFT POST PREVENT DAYS update
+46 ;
+47 DO BMES^XPDUTL("Fixing ERA numbers...")
+48 DO FIX3444
+49 ;
+50 DO BMES^XPDUTL("PRCA*4.5*332 post-installation finished "_$$HTE^XLFDT($HOROLOG))
+51 QUIT
+52 ;
+53 ;
FIX3444 ; Repair Internal Entry Numbers in 344.4 where IEN is not equal to .01
+1 NEW IEN,ENTRY
+2 SET IEN=0
+3 ;
FOR
SET IEN=$ORDER(^RCY(344.4,IEN))
if 'IEN
QUIT
Begin DoDot:1
+4 SET ENTRY=$PIECE($GET(^RCY(344.4,IEN,0)),"^",1)
+5 IF 'ENTRY
QUIT
+6 ;
IF ENTRY'=IEN
Begin DoDot:2
+7 NEW FDA
+8 SET FDA(344.4,IEN_",",.01)=IEN
+9 DO FILE^DIE("","FDA")
End DoDot:2
End DoDot:1
+10 QUIT
