BAREDP4B.m

BAREDP4B ; IHS/SD/POT - MATCH REASONS AND CLAIMS PART3; 03/17/2014

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69

 ;;IHS/SD/POT NEW ROUTINE - OVERFLOW CODE FROM BAREDP04

 Q

 ;

ADDREAS(IMPDA,CLMDA,ERRORS) ;EP - ADD RSN NOT SENT TO 'RSN NOT TO POST MULTIPLE'

 S SHOWMSG=$G(SHOWMSG)

 N REASON,STAT,ERRDA,CURSTAT

 S REASON=""

 F  S REASON=$O(ERRORS(REASON)) Q:REASON=""  D

 . I REASON="CT" D STAT(IMPDA,CLMDA)

 . I SHOWMSG D

 . .S ERRDA=$O(^BARERR("B",REASON,""))

 . .W !,$$GET1^DIQ(90056.21,ERRDA_",",.02,"E")

 . K DIC,DIE,DR,DA,DIR

 . S DIC("P")=$P(^DD(90056.0205,401,0),U,2)

 . S DA(2)=IMPDA

 . S DA(1)=CLMDA

 . S DIC(0)="L"

 . S DIC="^BAREDI(""I"",DUZ(2),"_DA(2)_",30,"_DA(1)_",4,"

 . S X=REASON

 . D ^DIC

 Q

 ;

STAT(IMPDA,CLMDA) ;EP

 K DR,DIE,DA

 S DIE=$$DIC^XBDIQ1(90056.0205)

 S STAT="C"

 S DR=".02///^S X=STAT"

 S DA(1)=IMPDA

 S DA=CLMDA

 D ^DIE

 Q

 ; 

DELREAS(IMPDA,CLMDA) ;EP -CLR 'RSN NOT TO POST' MULTIPLES IN ERA FILE

 N REASDA,BAREIENS

 K DA,DIR,DIC,DIE,DR

 S REASDA=0

 F  S REASDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,REASDA)) Q:'REASDA  D

 . S DA(2)=IMPDA

 . S DA(1)=CLMDA

 . S DIE="^BAREDI(""I"","_DUZ(2)_","_DA(2)_",30,"_DA(1)_",4,"

 . S DA=REASDA

 . S DR=".01///@"

 . D ^DIE

 K DA,DR,DIE,DIC,DIR

 S DIE=$$DIC^XBDIQ1(90056.0205)

 S DR=""

 S BAREIENS=CLMDA_","_IMPDA_","

 I $$GET1^DIQ(90056.0205,BAREIENS,71)="" S DR=".02///C"  ;'STATUS' FLD CLM UNMATCHED

 S DR=DR_";501///@"  ;'POST CLM AS TYPE'

 S DR=DR_";601///@"  ;'PYMT CRDT APPLIED TO'

 S DR=DR_";602///@"  ;'PYMT CRDT APPLIED FROM'

 S DA(1)=IMPDA

 S DA=CLMDA

 D ^DIE

 K DA,DR,DIE,DIC,DIR

 Q

 ;---EOR

BAREDP4B  ; IHS/SD/POT - MATCH REASONS AND CLAIMS PART3; 03/17/2014

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**24**;OCT 26, 2005;Build 69

 +2       ;;IHS/SD/POT NEW ROUTINE - OVERFLOW CODE FROM BAREDP04

 +3        QUIT 

 +4       ;

ADDREAS(IMPDA,CLMDA,ERRORS) ;EP - ADD RSN NOT SENT TO 'RSN NOT TO POST MULTIPLE'

 +1        SET SHOWMSG=$GET(SHOWMSG)

 +2        NEW REASON,STAT,ERRDA,CURSTAT

 +3        SET REASON=""

 +4        FOR 

               SET REASON=$ORDER(ERRORS(REASON))

               IF REASON=""

                   QUIT 

               Begin DoDot:1

 +5                IF REASON="CT"

                       DO STAT(IMPDA,CLMDA)

 +6                IF SHOWMSG

                       Begin DoDot:2

 +7                        SET ERRDA=$ORDER(^BARERR("B",REASON,""))

 +8                        WRITE !,$$GET1^DIQ(90056.21,ERRDA_",",.02,"E")

                       End DoDot:2

 +9                KILL DIC,DIE,DR,DA,DIR

 +10               SET DIC("P")=$PIECE(^DD(90056.0205,401,0),U,2)

 +11               SET DA(2)=IMPDA

 +12               SET DA(1)=CLMDA

 +13               SET DIC(0)="L"

 +14               SET DIC="^BAREDI(""I"",DUZ(2),"_DA(2)_",30,"_DA(1)_",4,"

 +15               SET X=REASON

 +16               DO ^DIC

               End DoDot:1

 +17       QUIT 

 +18      ;

STAT(IMPDA,CLMDA) ;EP

 +1        KILL DR,DIE,DA

 +2        SET DIE=$$DIC^XBDIQ1(90056.0205)

 +3        SET STAT="C"

 +4        SET DR=".02///^S X=STAT"

 +5        SET DA(1)=IMPDA

 +6        SET DA=CLMDA

 +7        DO ^DIE

 +8        QUIT 

 +9       ; 

DELREAS(IMPDA,CLMDA) ;EP -CLR 'RSN NOT TO POST' MULTIPLES IN ERA FILE

 +1        NEW REASDA,BAREIENS

 +2        KILL DA,DIR,DIC,DIE,DR

 +3        SET REASDA=0

 +4        FOR 

               SET REASDA=$ORDER(^BAREDI("I",DUZ(2),IMPDA,30,CLMDA,4,REASDA))

               IF 'REASDA

                   QUIT 

               Begin DoDot:1

 +5                SET DA(2)=IMPDA

 +6                SET DA(1)=CLMDA

 +7                SET DIE="^BAREDI(""I"","_DUZ(2)_","_DA(2)_",30,"_DA(1)_",4,"

 +8                SET DA=REASDA

 +9                SET DR=".01///@"

 +10               DO ^DIE

               End DoDot:1

 +11       KILL DA,DR,DIE,DIC,DIR

 +12       SET DIE=$$DIC^XBDIQ1(90056.0205)

 +13       SET DR=""

 +14       SET BAREIENS=CLMDA_","_IMPDA_","

 +15      ;'STATUS' FLD CLM UNMATCHED

           IF $$GET1^DIQ(90056.0205,BAREIENS,71)=""

               SET DR=".02///C"

 +16      ;'POST CLM AS TYPE'

           SET DR=DR_";501///@"

 +17      ;'PYMT CRDT APPLIED TO'

           SET DR=DR_";601///@"

 +18      ;'PYMT CRDT APPLIED FROM'

           SET DR=DR_";602///@"

 +19       SET DA(1)=IMPDA

 +20       SET DA=CLMDA

 +21       DO ^DIE

 +22       KILL DA,DR,DIE,DIC,DIR

 +23       QUIT 

 +24      ;---EOR