Routine: PRCAP214

PRCAP214 ;ALB/CXW - PATCH PRCA*4.5*214 PRE/POST-INIT

 ;;4.5;Accounts Receivable;**214**;Mar 20, 1995

PRE ;pre-init to ensure all entries for the EFTs are DINUMED

 N Z,DA,DIE,DR,X,Y

 S Z=0 F  S Z=$O(^RCY(344.3,Z)) Q:'Z  I Z'=+$G(^(Z,0)) S DA=Z,DR=".01////"_Z,DIE="^RCY(344.3," D ^DIE

POST ;post-init to build a list of the ERAs with invalid payment adjustments

 N RC,RC0,RCSEQ,RCIFN,RCOLD,RCT

 D MES^XPDUTL("LIST OF ERA's WITH INVALID PAYMENT ADJUSTMENTS")

 S RCOLD=-1,RC=0,RCT=0,RCIFN=""

 F  S RC=$O(^RCY(344.4,RC)) Q:'RC  F RCSEQ=1:1 S RCIFN=+$O(^RCY(344.4,RC,1,"B",RCSEQ,RCIFN)) D  Q:'RCIFN

 . I 'RCIFN Q:RCOLD'<0  S RC0=$G(^RCY(344.4,RC,0)) D MES^XPDUTL("  ERA #:"_RC_"  TRACE #:"_$P(RC0,U,2)_"  REC'D:"_$$FMTE^XLFDT($P(RC0,U,7),"2D")_"  MSG #:"_$P(RC0,U,12)) S RCT=RCT+1 Q

 . S RCOLD=$P($G(^RCY(344.4,RC,1,RCIFN,0)),U,3)

 D MES^XPDUTL("THERE WERE "_$S(RCT=0:"NO",1:RCT)_" ERA(s) FOUND")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP214   929     printed  Apr 09, 2024@20:45:03                                                                                                                                                                                                     Page 2

PRCAP214  ;ALB/CXW - PATCH PRCA*4.5*214 PRE/POST-INIT

 +1       ;;4.5;Accounts Receivable;**214**;Mar 20, 1995

 +2        QUIT

PRE       ;pre-init to ensure all entries for the EFTs are DINUMED

 +1        NEW Z,DA,DIE,DR,X,Y

 +2        SET Z=0

FOR

               SET Z=$ORDER(^RCY(344.3,Z))

               if 'Z

                   QUIT

               IF Z'=+$GET(^(Z,0))

                   SET DA=Z

                   SET DR=".01////"_Z

                   SET DIE="^RCY(344.3,"

                   DO ^DIE

 +3        QUIT

POST      ;post-init to build a list of the ERAs with invalid payment adjustments

 +1        NEW RC,RC0,RCSEQ,RCIFN,RCOLD,RCT

 +2       ;

 +3        DO MES^XPDUTL("LIST OF ERA's WITH INVALID PAYMENT ADJUSTMENTS")

 +4       ;

 +5        SET RCOLD=-1

           SET RC=0

           SET RCT=0

           SET RCIFN=""

 +6        FOR

               SET RC=$ORDER(^RCY(344.4,RC))

               if 'RC

                   QUIT

               FOR RCSEQ=1:1

                   SET RCIFN=+$ORDER(^RCY(344.4,RC,1,"B",RCSEQ,RCIFN))

                   Begin DoDot:1

 +7                    IF 'RCIFN

                           if RCOLD'<0

                               QUIT

                           SET RC0=$GET(^RCY(344.4,RC,0))

                           DO MES^XPDUTL("  ERA #:"_RC_"  TRACE #:"_$PIECE(RC0,U,2)_"  REC'D:"_$$FMTE^XLFDT($PIECE(RC0,U,7),"2D")_"  MSG #:"_$PIECE(RC0,U,12))

                           SET RCT=RCT+1

                           QUIT

 +8                    SET RCOLD=$PIECE($GET(^RCY(344.4,RC,1,RCIFN,0)),U,3)

                   End DoDot:1

                   if 'RCIFN

                       QUIT

 +9       ;

 +10       DO MES^XPDUTL("THERE WERE "_$SELECT(RCT=0:"NO",1:RCT)_" ERA(s) FOUND")

 +11       QUIT

PRCAP214.m