RCP345.m

RCP345 ;AITC/CJE,hrubovcak - ePayment Lockbox Post-Installation Processing ;22 Jan 2019 14:32:31

 ;;4.5;Accounts Receivable;**345**;Mar 20, 1995;Build 34

 ;Per VA Directive 6402, this routine should not be modified.

 Q

 ;

POST ;

 D AUTO1

 ;

 D BMES^XPDUTL("Creating index on CARC Auto-Decrease No Pay (#344.62)")

 S DIK="^RCY(344.62,",DIK(1)=".08^ACTVN" D ENALL^DIK

 ;

 D RXADDF ; Populate defaults for Pharmacy Auto-Decrease

EFT ;

 S ZTRTN="EFT3446^"_$T(+0),ZTDESC="Add EFT Payer/TIN to 344.6",ZTIO="",ZTDTH=$H

 D ^%ZTLOAD

 D MES^XPDUTL($S($G(ZTSK):"Task# "_ZTSK_" queued, to add EFTs to 344.6",1:"Unable to queue EFT 344.6 task."))

 ;

 D BMES^XPDUTL("Fixing ERA numbers...")

 D FIX3444

 ;

 D BMES^XPDUTL("PRCA*4.5*345 post-installation finished "_$$HTE^XLFDT($H))

 Q

 ;

AUTO1 ; Populate default values for 1st party auto-decrease

 N FDA,IEN3501,J,RCLIST

 D BMES^XPDUTL("Populate default values for 1st party auto-decrease (#342)")

 S FDA(342,"1,",.14)=0

 S FDA(342,"1,",.15)=0

 D FILE^DIE("","FDA")

 ;

 S RCLIST(1)="DG FEE SERVICE (OPT) NEW"

 S RCLIST(2)="DG OPT COPAY NEW"

 ; S RCLIST(3)="PSO NSC RX COPAY NEW"

 ; S RCLIST(4)="PSO SC RX COPAY NEW"

 S RCLIST(3)="CC (OPT) NEW"

 ;

 K ^RC(342,1,14)

 S J=0 F  S J=$O(RCLIST(J)) Q:'J  D  ;

 . S IEN3501=$O(^IBE(350.1,"B",RCLIST(J),0))

 . I IEN3501 D  ;

 . . K FDA,IENS

 . . S FDA(342.014,"+1,1,",.01)=IEN3501

 . . S FDA(342.014,"+1,1,",.02)=1

 . . D UPDATE^DIE("","FDA")

 Q

 ;

RXADDF ; Populate defaults for Pharmacy Auto-Decrease

 N FDA

 S FDA(344.61,"1,",1.02)=0

 S FDA(344.61,"1,",1.03)=5

 S FDA(344.61,"1,",1.04)=100

 D FILE^DIE("","FDA")

 Q

 ;

EFT3446 ; Add EFT Payer/TINs to payer exclusion file

 N ID,IEN,NAME,RET

 S IEN=0

 F  S IEN=$O(^RCY(344.31,IEN)) Q:'IEN  D  ;

 . S NAME=$$GET1^DIQ(344.31,IEN_",",.02)

 . S ID=$$GET1^DIQ(344.31,IEN_",",.03)

 . I NAME=""!(ID="") Q

 . I '$D(^RCY(344.6,"CPID",NAME,ID)) S RET=$$PAYRINIT^RCDPESP(IEN,344.31)

 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 ---RCP345   2276     printed  Mar 13, 2025@20:51:58                                                                                                                                                                                                      Page 2

RCP345    ;AITC/CJE,hrubovcak - ePayment Lockbox Post-Installation Processing ;22 Jan 2019 14:32:31

 +1       ;;4.5;Accounts Receivable;**345**;Mar 20, 1995;Build 34

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3        QUIT 

 +4       ;

POST      ;

 +1        DO AUTO1

 +2       ;

 +3        DO BMES^XPDUTL("Creating index on CARC Auto-Decrease No Pay (#344.62)")

 +4        SET DIK="^RCY(344.62,"

           SET DIK(1)=".08^ACTVN"

           DO ENALL^DIK

 +5       ;

 +6       ; Populate defaults for Pharmacy Auto-Decrease

           DO RXADDF

EFT       ;

 +1        SET ZTRTN="EFT3446^"_$TEXT(+0)

           SET ZTDESC="Add EFT Payer/TIN to 344.6"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

 +2        DO ^%ZTLOAD

 +3        DO MES^XPDUTL($SELECT($GET(ZTSK):"Task# "_ZTSK_" queued, to add EFTs to 344.6",1:"Unable to queue EFT 344.6 task."))

 +4       ;

 +5        DO BMES^XPDUTL("Fixing ERA numbers...")

 +6        DO FIX3444

 +7       ;

 +8        DO BMES^XPDUTL("PRCA*4.5*345 post-installation finished "_$$HTE^XLFDT($HOROLOG))

 +9        QUIT 

 +10      ;

AUTO1     ; Populate default values for 1st party auto-decrease

 +1        NEW FDA,IEN3501,J,RCLIST

 +2        DO BMES^XPDUTL("Populate default values for 1st party auto-decrease (#342)")

 +3        SET FDA(342,"1,",.14)=0

 +4        SET FDA(342,"1,",.15)=0

 +5        DO FILE^DIE("","FDA")

 +6       ;

 +7        SET RCLIST(1)="DG FEE SERVICE (OPT) NEW"

 +8        SET RCLIST(2)="DG OPT COPAY NEW"

 +9       ; S RCLIST(3)="PSO NSC RX COPAY NEW"

 +10      ; S RCLIST(4)="PSO SC RX COPAY NEW"

 +11       SET RCLIST(3)="CC (OPT) NEW"

 +12      ;

 +13       KILL ^RC(342,1,14)

 +14      ;

           SET J=0

           FOR 

               SET J=$ORDER(RCLIST(J))

               if 'J

                   QUIT 

               Begin DoDot:1

 +15               SET IEN3501=$ORDER(^IBE(350.1,"B",RCLIST(J),0))

 +16      ;

                   IF IEN3501

                       Begin DoDot:2

 +17                       KILL FDA,IENS

 +18                       SET FDA(342.014,"+1,1,",.01)=IEN3501

 +19                       SET FDA(342.014,"+1,1,",.02)=1

 +20                       DO UPDATE^DIE("","FDA")

                       End DoDot:2

               End DoDot:1

 +21       QUIT 

 +22      ;

RXADDF    ; Populate defaults for Pharmacy Auto-Decrease

 +1        NEW FDA

 +2        SET FDA(344.61,"1,",1.02)=0

 +3        SET FDA(344.61,"1,",1.03)=5

 +4        SET FDA(344.61,"1,",1.04)=100

 +5        DO FILE^DIE("","FDA")

 +6        QUIT 

 +7       ;

EFT3446   ; Add EFT Payer/TINs to payer exclusion file

 +1        NEW ID,IEN,NAME,RET

 +2        SET IEN=0

 +3       ;

           FOR 

               SET IEN=$ORDER(^RCY(344.31,IEN))

               if 'IEN

                   QUIT 

               Begin DoDot:1

 +4                SET NAME=$$GET1^DIQ(344.31,IEN_",",.02)

 +5                SET ID=$$GET1^DIQ(344.31,IEN_",",.03)

 +6                IF NAME=""!(ID="")

                       QUIT 

 +7                IF '$DATA(^RCY(344.6,"CPID",NAME,ID))

                       SET RET=$$PAYRINIT^RCDPESP(IEN,344.31)

               End DoDot:1

 +8        QUIT 

 +9       ;

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