Routine: BAR50P06

BAR50P06 ; IHS/SD/LSL - POST CLAIMS ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,21**;OCT 26, 2005

;;

 ; IHS/SD/LSL - 11/26/02 - V1.7 - NOIS QAA-1200-130051

 ;       Modified to Q if error in creating a transaction

 ; ********************************************************************

EN(TRDA,IMPDA)     ; EP

 ; LOOP Claims in M status and post

 D INIT^BARUTL

 S BARSECT=BARUSR(29,"I")

 S CLMDA=0

 F  S CLMDA=$O(^BAREDI("I",DUZ(2),IMPDA,30,"AC","M",CLMDA)) Q:CLMDA'>0  D

 . D BASIC ; (gather claim data & build BARDR string)

 . D PAY

 . D ADJMULT

 . D MRKCLMP

 ; *********************************************************************

PAY ;EP

 ; PULL CLAIM INFO AND POST PAYMENT (IF ANY)

 K BARCR,CLM

 D ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01;.05;1.01;.02;.04","CLM(")

 W !!,"Claim: ",CLM(.01)," <> ",CLM(1.01)

 W !?5,"Billed: ",CLM(.05),?25,"Payment: ",CLM(.04)

 S BARCR=$$VALI^XBDIQ1(90056.0205,"IMPDA,CLMDA",.04)

 Q:BARCR=0

 S BARTRAN=40

 I +$G(BARCOL),+$G(BARITM)

 E  Q

 D POST

 ; *********************************************************************

ADJMULT ;EP

 ; POST ADJUSTMENTS

 K ADJ

 S DR=BARDR_";102////^S X=BARCAT;103////^S X=BARREA"

 D ENPM^XBDIQ1(90056.0208,"IMPDA,CLMDA,0",".02;.04;.05","ADJ(","I")

 Q:'$D(ADJ)

 S BARTRAN=43

 S ADJDA=0

 F  S ADJDA=$O(ADJ(ADJDA)) Q:ADJDA'>0  D

 . S BARCR=ADJ(ADJDA,.02,"I")

 . S BARCAT=ADJ(ADJDA,.04,"I")

 . S BARREA=ADJ(ADJDA,.05,"I")

 . S DR=BARDR_";102////^S X=BARCAT;103////^S X=BARREA"

 . D POST

 . K ADJP

 . D ENP^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA",".02;.04;.05","ADJP(")

 . W !?5,"ADJ: ",ADJP(.02),?25,ADJP(.04),?45,ADJP(.05)

 ; *********************************************************************

MRKCLMP ;EP

 ; MARK CLAIM AS POSTED

 K DIC,DA,DR

 S DIE=$$DIC^XBDIQ1(90056.0205)

 S DA(1)=IMPDA

 S DA=CLMDA

 S DR=".02////P"

 D ^DIE

 K DIC,DA,DR

 ; *********************************************************************

BASIC ;EP ASSEMBLE BASIC DATA FOR TRANSACTION

 S BARBLIEN=$$VALI^XBDIQ1(90056.0205,"IMPDA,CLMDA",1.01) ; A/R BILL

 S BARBLPAT=$$GET1^DIQ(90050.01,BARBLIEN,101,"I")  ; A/R Patient IEN

 S BARBLAC=$$GET1^DIQ(90050.01,BARBLIEN,3,"I")     ; A/R Account

 S BARCOL=$$GET1^DIQ(90056.02,IMPDA,.06,"I") ;  A/R COLLECTION BATCH IEN

 S BARITM=$$GET1^DIQ(90056.02,IMPDA,.07,"I") ; A/R COL BATCH ITEM

 S BARVLOC=$$GET1^DIQ(90056.02,IMPDA,108,"I") ; A/R LOCATION

 S DR="2////^S X=BARCR"

 S DR=DR_";4////^S X=BARBLIEN"        ; A/R Bill

 S DR=DR_";5////^S X=BARBLPAT"        ; A/R Patient

 S DR=DR_";6////^S X=BARBLAC"         ; A/R Account

 S DR=DR_";8////^S X=DUZ(2)"          ; Parent Location

 S DR=DR_";9////^S X=DUZ(2)"          ; Parent ASUFAC

 S DR=DR_";10////^S X=BARSECT"        ; A/R Section

 S DR=DR_";11////^S X=BARVLOC"         ; Visit Location

 S DR=DR_";12////^S X=DT" ; Date

 S DR=DR_";13////^S X=DUZ"            ; Entry by

 S DR=DR_";14////^S X=$G(BARCOL)"         ; IEN to A/R COLLECTION BATCH

 S DR=DR_";15////^S X=$G(BARITM)"         ; IEN to ITEM mult in A/R COL

 S DR=DR_";101////^S X=BARTRAN"       ; Transaction Type

 S BARDR=DR

 S (BARCAT,BARREA)=""

 ; *********************************************************************

POST ;EP

 ; SET TRANSACTION & POST FILES

 S BARTRIEN=$$NEW^BARTR               ; Create Transaction

 I BARTRIEN<1 D MSG^BARTR(BARBLIEN) Q

 S BARROLL(BARBLIEN)=""

 ; Populate Transaction file

 S DA=BARTRIEN                        ; IEN to A/R TRANSACTION

 S DIE=90050.03

 S DIDEL=90050

 D ^DIE

 K DIDEL,DIE,DA,DR

 ; Post from transaction file to related files

 D TR^BARTDO(BARTRIEN)

BAR50P06  ; IHS/SD/LSL - POST CLAIMS ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**1,21**;OCT 26, 2005

 +2       ;;

 +3       ; IHS/SD/LSL - 11/26/02 - V1.7 - NOIS QAA-1200-130051

 +4       ;       Modified to Q if error in creating a transaction

 +5       ;

 +6       ; ********************************************************************

 +7       ;

EN(TRDA,IMPDA) ; EP

 +1       ; LOOP Claims in M status and post

 +2        DO INIT^BARUTL

 +3        SET BARSECT=BARUSR(29,"I")

 +4        SET CLMDA=0

 +5        FOR

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

               IF CLMDA'>0

                   QUIT

               Begin DoDot:1

 +6       ; (gather claim data & build BARDR string)

                   DO BASIC

 +7                DO PAY

 +8                DO ADJMULT

 +9                DO MRKCLMP

               End DoDot:1

 +10       QUIT

 +11      ; *********************************************************************

 +12      ;

PAY       ;EP

 +1       ; PULL CLAIM INFO AND POST PAYMENT (IF ANY)

 +2        KILL BARCR,CLM

 +3        DO ENP^XBDIQ1(90056.0205,"IMPDA,CLMDA",".01;.05;1.01;.02;.04","CLM(")

 +4        WRITE !!,"Claim: ",CLM(.01)," <> ",CLM(1.01)

 +5        WRITE !?5,"Billed: ",CLM(.05),?25,"Payment: ",CLM(.04)

 +6        SET BARCR=$$VALI^XBDIQ1(90056.0205,"IMPDA,CLMDA",.04)

 +7        IF BARCR=0

               QUIT

 +8        SET BARTRAN=40

 +9        IF +$GET(BARCOL)

               IF +$GET(BARITM)

 +10      IF '$TEST

               QUIT

 +11       DO POST

 +12       QUIT

 +13      ; *********************************************************************

 +14      ;

ADJMULT   ;EP

 +1       ; POST ADJUSTMENTS

 +2        KILL ADJ

 +3        SET DR=BARDR_";102////^S X=BARCAT;103////^S X=BARREA"

 +4        DO ENPM^XBDIQ1(90056.0208,"IMPDA,CLMDA,0",".02;.04;.05","ADJ(","I")

 +5        IF '$DATA(ADJ)

               QUIT

 +6        SET BARTRAN=43

 +7        SET ADJDA=0

 +8        FOR

               SET ADJDA=$ORDER(ADJ(ADJDA))

               IF ADJDA'>0

                   QUIT

               Begin DoDot:1

 +9                SET BARCR=ADJ(ADJDA,.02,"I")

 +10               SET BARCAT=ADJ(ADJDA,.04,"I")

 +11               SET BARREA=ADJ(ADJDA,.05,"I")

 +12               SET DR=BARDR_";102////^S X=BARCAT;103////^S X=BARREA"

 +13               DO POST

 +14               KILL ADJP

 +15               DO ENP^XBDIQ1(90056.0208,"IMPDA,CLMDA,ADJDA",".02;.04;.05","ADJP(")

 +16               WRITE !?5,"ADJ: ",ADJP(.02),?25,ADJP(.04),?45,ADJP(.05)

               End DoDot:1

 +17       QUIT

 +18      ; *********************************************************************

 +19      ;

MRKCLMP   ;EP

 +1       ; MARK CLAIM AS POSTED

 +2        KILL DIC,DA,DR

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

 +4        SET DA(1)=IMPDA

 +5        SET DA=CLMDA

 +6        SET DR=".02////P"

 +7        DO ^DIE

 +8        KILL DIC,DA,DR

 +9        QUIT

 +10      ; *********************************************************************

 +11      ;

BASIC     ;EP ASSEMBLE BASIC DATA FOR TRANSACTION

 +1       ;

 +2       ; A/R BILL

           SET BARBLIEN=$$VALI^XBDIQ1(90056.0205,"IMPDA,CLMDA",1.01)

 +3       ; A/R Patient IEN

           SET BARBLPAT=$$GET1^DIQ(90050.01,BARBLIEN,101,"I")

 +4       ; A/R Account

           SET BARBLAC=$$GET1^DIQ(90050.01,BARBLIEN,3,"I")

 +5       ;  A/R COLLECTION BATCH IEN

           SET BARCOL=$$GET1^DIQ(90056.02,IMPDA,.06,"I")

 +6       ; A/R COL BATCH ITEM

           SET BARITM=$$GET1^DIQ(90056.02,IMPDA,.07,"I")

 +7       ; A/R LOCATION

           SET BARVLOC=$$GET1^DIQ(90056.02,IMPDA,108,"I")

 +8        SET DR="2////^S X=BARCR"

 +9       ; A/R Bill

           SET DR=DR_";4////^S X=BARBLIEN"

 +10      ; A/R Patient

           SET DR=DR_";5////^S X=BARBLPAT"

 +11      ; A/R Account

           SET DR=DR_";6////^S X=BARBLAC"

 +12      ; Parent Location

           SET DR=DR_";8////^S X=DUZ(2)"

 +13      ; Parent ASUFAC

           SET DR=DR_";9////^S X=DUZ(2)"

 +14      ; A/R Section

           SET DR=DR_";10////^S X=BARSECT"

 +15      ; Visit Location

           SET DR=DR_";11////^S X=BARVLOC"

 +16      ; Date

           SET DR=DR_";12////^S X=DT"

 +17      ; Entry by

           SET DR=DR_";13////^S X=DUZ"

 +18      ; IEN to A/R COLLECTION BATCH

           SET DR=DR_";14////^S X=$G(BARCOL)"

 +19      ; IEN to ITEM mult in A/R COL

           SET DR=DR_";15////^S X=$G(BARITM)"

 +20      ; Transaction Type

           SET DR=DR_";101////^S X=BARTRAN"

 +21       SET BARDR=DR

 +22       SET (BARCAT,BARREA)=""

 +23       QUIT

 +24      ; *********************************************************************

 +25      ;

POST      ;EP

 +1       ; SET TRANSACTION & POST FILES

 +2       ; Create Transaction

           SET BARTRIEN=$$NEW^BARTR

 +3        IF BARTRIEN<1

               DO MSG^BARTR(BARBLIEN)

               QUIT

 +4        SET BARROLL(BARBLIEN)=""

 +5       ; Populate Transaction file

 +6       ; IEN to A/R TRANSACTION

           SET DA=BARTRIEN

 +7        SET DIE=90050.03

 +8        SET DIDEL=90050

 +9        DO ^DIE

 +10       KILL DIDEL,DIE,DA,DR

 +11      ; Post from transaction file to related files

 +12       DO TR^BARTDO(BARTRIEN)

 +13       QUIT

BAR50P06.m