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 ---[H[J[2J[HRCP326   2425     printed  Sep 23, 2025@19:23:25                                                                                                                                                                                                      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