Routine: RCP332

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.

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))

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")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCP332   3287     printed  Mar 13, 2025@20:51:57                                                                                                                                                                                                      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

RCP332.m