RCP326.m

RCP326 ;BIRM/EWL ALB/PJH - ePayment Lockbox Post-Installation Processing ;Dec 20, 2014@14:08:45

 ;;4.5;Accounts Receivable;**326**;Jan 21, 2014;Build 26

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

 Q

 ;

POST() ;

 N DIK

 D BMES^XPDUTL("Re-indexing TRANSACTION#  on EFT DETAIL file (#344.31)")

 S DIK="^RCY(344.31,",DIK(1)=".14^D" D ENALL^DIK

 ;

 D BMES^XPDUTL("Creating index by payer name and TIN on EFT DETAIL file (#344.31)")

 S DIK="^RCY(344.31,",DIK(1)=".02^APT" D ENALL^DIK

 ;

 D BMES^XPDUTL("Creating index by TIN and payer name on EFT DETAIL file (#344.31)")

 S DIK="^RCY(344.31,",DIK(1)=".03^ATP" D ENALL^DIK

 ;

 D BMES^XPDUTL("Creating index by payer name and TIN on ERA file (#344.4)")

 S DIK="^RCY(344.4,",DIK(1)=".06^APT" D ENALL^DIK

 ;

 D BMES^XPDUTL("Creating index by TIN and payer name on ERA file (#344.4)")

 S DIK="^RCY(344.4,",DIK(1)=".03^ATP" D ENALL^DIK

 ;

 D BMES^XPDUTL("Creating index by pharmacy flag on Payer Exclusion file (#344.6)")

 S DIK="^RCY(344.6,",DIK(1)=".09^ARX" D ENALL^DIK

 ;

 D BMES^XPDUTL("Creating index by tricare flag on Payer Exclusion file (#344.6)")

 S DIK="^RCY(344.6,",DIK(1)=".1^ATR" D ENALL^DIK

 ;

 ; Populate MED AMT DEFAULT AUTO-DECREASE

 D:$$GET1^DIQ(344.61,"1,",.05)=""

 .N DA,DIE,DR

 .S DIE="^RCY(344.61,",DR=".05///5000;",DA=1 D ^DIE

 ;

US786 ;

 D BMES^XPDUTL("Converting RCDPE APAR, MEDICAL/PHARMACY parameter from 'Both' to 'All'")

 N RCENT,RCERR,RCINST,RCOUT,RCPAR

 K ^TMP($J,"RCP326")

 S RCOUT="^TMP($J,""RCP326"")"

 S RCPAR="RCDPE APAR"

 S RCINST="MEDICAL/PHARMACY"

 D ENVAL^XPAR(.RCOUT,RCPAR,RCINST,.RCERR,1) ; IA 2992 PARAMETER DEFINITION TOOLKIT

 S RCENT=""

 F  S RCENT=$O(^TMP($J,"RCP326",RCENT)) Q:RCENT=""  D  ;

 . I $G(^TMP($J,"RCP326",RCENT,RCINST))="B" D  ;

 . . D EN^XPAR(RCENT,RCPAR,RCINST,"A",.RCERR) ; IA 2992 PARAMETER DEFINITION TOOLKIT

 K ^TMP($J,"RCP326")

 ;

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

 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RCP326   2425     printed  Mar 13, 2025@20:51:56                                                                                                                                                                                                      Page 2

RCP326    ;BIRM/EWL ALB/PJH - ePayment Lockbox Post-Installation Processing ;Dec 20, 2014@14:08:45

 +1       ;;4.5;Accounts Receivable;**326**;Jan 21, 2014;Build 26

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

 +3        QUIT 

 +4       ;

POST()    ;

 +1        NEW DIK

 +2        DO BMES^XPDUTL("Re-indexing TRANSACTION#  on EFT DETAIL file (#344.31)")

 +3        SET DIK="^RCY(344.31,"

           SET DIK(1)=".14^D"

           DO ENALL^DIK

 +4       ;

 +5        DO BMES^XPDUTL("Creating index by payer name and TIN on EFT DETAIL file (#344.31)")

 +6        SET DIK="^RCY(344.31,"

           SET DIK(1)=".02^APT"

           DO ENALL^DIK

 +7       ;

 +8        DO BMES^XPDUTL("Creating index by TIN and payer name on EFT DETAIL file (#344.31)")

 +9        SET DIK="^RCY(344.31,"

           SET DIK(1)=".03^ATP"

           DO ENALL^DIK

 +10      ;

 +11       DO BMES^XPDUTL("Creating index by payer name and TIN on ERA file (#344.4)")

 +12       SET DIK="^RCY(344.4,"

           SET DIK(1)=".06^APT"

           DO ENALL^DIK

 +13      ;

 +14       DO BMES^XPDUTL("Creating index by TIN and payer name on ERA file (#344.4)")

 +15       SET DIK="^RCY(344.4,"

           SET DIK(1)=".03^ATP"

           DO ENALL^DIK

 +16      ;

 +17       DO BMES^XPDUTL("Creating index by pharmacy flag on Payer Exclusion file (#344.6)")

 +18       SET DIK="^RCY(344.6,"

           SET DIK(1)=".09^ARX"

           DO ENALL^DIK

 +19      ;

 +20       DO BMES^XPDUTL("Creating index by tricare flag on Payer Exclusion file (#344.6)")

 +21       SET DIK="^RCY(344.6,"

           SET DIK(1)=".1^ATR"

           DO ENALL^DIK

 +22      ;

 +23      ; Populate MED AMT DEFAULT AUTO-DECREASE

 +24       if $$GET1^DIQ(344.61,"1,",.05)=""

               Begin DoDot:1

 +25               NEW DA,DIE,DR

 +26               SET DIE="^RCY(344.61,"

                   SET DR=".05///5000;"

                   SET DA=1

                   DO ^DIE

               End DoDot:1

 +27      ;

US786     ;

 +1        DO BMES^XPDUTL("Converting RCDPE APAR, MEDICAL/PHARMACY parameter from 'Both' to 'All'")

 +2        NEW RCENT,RCERR,RCINST,RCOUT,RCPAR

 +3        KILL ^TMP($JOB,"RCP326")

 +4        SET RCOUT="^TMP($J,""RCP326"")"

 +5        SET RCPAR="RCDPE APAR"

 +6        SET RCINST="MEDICAL/PHARMACY"

 +7       ; IA 2992 PARAMETER DEFINITION TOOLKIT

           DO ENVAL^XPAR(.RCOUT,RCPAR,RCINST,.RCERR,1)

 +8        SET RCENT=""

 +9       ;

           FOR 

               SET RCENT=$ORDER(^TMP($JOB,"RCP326",RCENT))

               if RCENT=""

                   QUIT 

               Begin DoDot:1

 +10      ;

                   IF $GET(^TMP($JOB,"RCP326",RCENT,RCINST))="B"

                       Begin DoDot:2

 +11      ; IA 2992 PARAMETER DEFINITION TOOLKIT

                           DO EN^XPAR(RCENT,RCPAR,RCINST,"A",.RCERR)

                       End DoDot:2

               End DoDot:1

 +12       KILL ^TMP($JOB,"RCP326")

 +13      ;

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

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

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

 +15       DO ^%ZTLOAD

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

 +17       QUIT 

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