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
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
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)
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
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)=""
Q
; *********************************************************************
;
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)
Q
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
