BARPST7 ; IHS/SD/LSL - UNALLOCATED POSTING ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**3,21,27**;OCT 26, 2005;Build 12
;vc; Version BARPST7.INT/BAR.1 Date 29-Aug-17 By User Location BAR$M
;vc; Component name INT.BARPST7 Routine name: BARPST7
;
; IHS/SD/LSL - 11/27/02 - V1.7 - QAA-1200-130051
; Modified to not update other files if couldn't create a
; transaction.
; IHS/DIT/CPC New Medicare Card Initiative HEAT348817 11/3/2017 - BAR*1.8*27
; Visit location not updating if Mult 3P EOB parameter set
;
; ********************************************************************
;
;** post unallocated cash
;
Q
;--------------------------------------------------------------------
UNALC(BARCB,BARITM,BARSUB) ;EP - Unallocated posting
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q ;IS SESSION STILL OPEN
;
N BARUN
TRYAGIN ;
D TOP^BARPST1(0)
W !!!
S DIR(0)="NOA^0:"_$S(BARSUB:BARVSIT(4),1:BARCLIT(19))_":2"
S DIR("A")="Enter UNALLOCATED amount: "
D ^DIR
K DIR
Q:$D(DUOUT)!(+Y=0)
S BARUN("AMT")=Y
W *7,!!,"Amount: "_$J(BARUN("AMT"),0,2)
S DIR("A")="OK to Post to UNALLOCATED CASH"
S DIR("B")="YES"
S DIR(0)="Y"
D ^DIR
K DIR
I Y'=1 G TRYAGIN
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) G EXIT ;IS SESSION STILL OPEN
W !!,"Updating Account, Transaction and Batch files now..."
N DA
S DIC=$$DIC^XBSFGBL(90051.1101)
S DA(1)=+BARCB
S DA=+BARITM
S BARUN("ACCT")=$$VALI^XBDIQ1(DIC,.DA,7)
D TX
I BARTRIEN<1 G TRYAGIN
D BATCH
D ACC(BARUN("ACCT"))
; -------------------------------
;
EXIT ;
D EOP^BARUTL(1)
Q
; *********************************************************************
;
ACC(DA) ;** update un-allocated account
N DIC,DIE,DR
Q:'DA
S DIC="^BARAC(DUZ(2),"
S DIC(0)="LX"
S BARUN(304)=$$GET1^DIQ(90050.02,DA,304,"I")
S BARUN(302)=$$GET1^DIQ(90050.02,DA,302,"I")
S DIE=DIC
S DR="304////^S X=BARUN(304)+BARUN(""AMT"")"
S DR=DR_";302////^S X=BARUN(302)-BARUN(""AMT"")"
S DIDEL=90050
D ^DIE
K DIDEL
Q
; *********************************************************************
;
BATCH ;** update batch
N DA,DR,DIE,DIC,BARPMT
S BARPMT=BARUN("AMT")
; -------------------------------
;
SLVL ;
; ** sub eob level
G:'$G(BARSUB) ILVL
S (DIC,DIE)=$$DIC^XBSFGBL(90051.1101601)
S DA(2)=+BARCB
S DA(1)=+BARITM
S DA=+BARSUB
S BARUN(5)=$$VALI^XBDIQ1(DIC,.DA,5)
S DR="5////^S X=BARUN(5)+BARPMT"
S DIDEL=90050
D ^DIE
K DIDEL
; -------------------------------
;
ILVL ;
; ** item level
S (DIC,DIE)=$$DIC^XBSFGBL(90051.1101)
S DA(1)=+BARCB
S DA=+BARITM
S BARUN("ACCT")=$$VALI^XBDIQ1(DIC,.DA,7)
Q:$G(BARSUB)
S BARUN(105)=$$VALI^XBDIQ1(DIC,.DA,105)
S DR="105////^S X=BARUN(105)+BARPMT"
S DIDEL=90050
D ^DIE
K DIDEL
Q
; *********************************************************************
;
BLVL ;
; ** batch level
;
TX ;** create transaction
;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
I $$NOTOPEN^BARUFUT(.DUZ,$G(UFMSESID)) Q ;IS SESSION STILL OPEN
N DIC,BARCR,BARAC,BARTT
S DIE="^BARTR(DUZ(2),"
S DIC(0)="LX"
K DO,DD
S BARCR=BARUN("AMT")
S BARAC=BARUN("ACCT")
S BARTT=$O(^BARTBL("B","UN-ALLOCATED",0))
; -------------------------------
;
PX ;
S X=$$NEW^BARTR
S BARTRIEN=X
I BARTRIEN<1 D Q
. W !!,"The system could not create an UN-ALLOCATED transaction. Please try again.",!
S DA=X
S DR="2////^S X=BARCR"
S DR=DR_";6////^S X=BARAC"
S DR=DR_";12////^S X=DT"
S DR=DR_";13////^S X=DUZ"
S DR=DR_";14////^S X=BARCB"
S DR=DR_";101////^S X=BARTT"
S DR=DR_";15////^S X=BARITM"
S DR=DR_";105////^S X=""O"""
S DR=DR_";104////^S X=1"
S DR=DR_";10////^S X=$$VALI^XBDIQ1(200,DUZ,29)"
S:$D(BAREOB) DR=DR_";11////^S X=BAREOB" ; HEAT348817 - IHS/SD/CPC - 20170829
S DIDEL=90050
D ^DIE
K DIDEL
;
S X=$$TRANTRIG^BARUFUT(DUZ,UFMSESID,BARTRIEN) ;BAR*1.8*3 UFMS
Q
BARPST7 ; IHS/SD/LSL - UNALLOCATED POSTING ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,21,27**;OCT 26, 2005;Build 12
+2 ;vc; Version BARPST7.INT/BAR.1 Date 29-Aug-17 By User Location BAR$M
+3 ;vc; Component name INT.BARPST7 Routine name: BARPST7
+4 ;
+5 ; IHS/SD/LSL - 11/27/02 - V1.7 - QAA-1200-130051
+6 ; Modified to not update other files if couldn't create a
+7 ; transaction.
+8 ; IHS/DIT/CPC New Medicare Card Initiative HEAT348817 11/3/2017 - BAR*1.8*27
+9 ; Visit location not updating if Mult 3P EOB parameter set
+10 ;
+11 ; ********************************************************************
+12 ;
+13 ;** post unallocated cash
+14 ;
+15 QUIT
+16 ;--------------------------------------------------------------------
UNALC(BARCB,BARITM,BARSUB) ;EP - Unallocated posting
+1 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
+2 ;IS SESSION STILL OPEN
IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))
QUIT
+3 ;
+4 NEW BARUN
TRYAGIN ;
+1 DO TOP^BARPST1(0)
+2 WRITE !!!
+3 SET DIR(0)="NOA^0:"_$SELECT(BARSUB:BARVSIT(4),1:BARCLIT(19))_":2"
+4 SET DIR("A")="Enter UNALLOCATED amount: "
+5 DO ^DIR
+6 KILL DIR
+7 IF $DATA(DUOUT)!(+Y=0)
QUIT
+8 SET BARUN("AMT")=Y
+9 WRITE *7,!!,"Amount: "_$JUSTIFY(BARUN("AMT"),0,2)
+10 SET DIR("A")="OK to Post to UNALLOCATED CASH"
+11 SET DIR("B")="YES"
+12 SET DIR(0)="Y"
+13 DO ^DIR
+14 KILL DIR
+15 IF Y'=1
GOTO TRYAGIN
+16 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
+17 ;IS SESSION STILL OPEN
IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))
GOTO EXIT
+18 WRITE !!,"Updating Account, Transaction and Batch files now..."
+19 NEW DA
+20 SET DIC=$$DIC^XBSFGBL(90051.1101)
+21 SET DA(1)=+BARCB
+22 SET DA=+BARITM
+23 SET BARUN("ACCT")=$$VALI^XBDIQ1(DIC,.DA,7)
+24 DO TX
+25 IF BARTRIEN<1
GOTO TRYAGIN
+26 DO BATCH
+27 DO ACC(BARUN("ACCT"))
+28 ; -------------------------------
+29 ;
EXIT ;
+1 DO EOP^BARUTL(1)
+2 QUIT
+3 ; *********************************************************************
+4 ;
ACC(DA) ;** update un-allocated account
+1 NEW DIC,DIE,DR
+2 IF 'DA
QUIT
+3 SET DIC="^BARAC(DUZ(2),"
+4 SET DIC(0)="LX"
+5 SET BARUN(304)=$$GET1^DIQ(90050.02,DA,304,"I")
+6 SET BARUN(302)=$$GET1^DIQ(90050.02,DA,302,"I")
+7 SET DIE=DIC
+8 SET DR="304////^S X=BARUN(304)+BARUN(""AMT"")"
+9 SET DR=DR_";302////^S X=BARUN(302)-BARUN(""AMT"")"
+10 SET DIDEL=90050
+11 DO ^DIE
+12 KILL DIDEL
+13 QUIT
+14 ; *********************************************************************
+15 ;
BATCH ;** update batch
+1 NEW DA,DR,DIE,DIC,BARPMT
+2 SET BARPMT=BARUN("AMT")
+3 ; -------------------------------
+4 ;
SLVL ;
+1 ; ** sub eob level
+2 IF '$GET(BARSUB)
GOTO ILVL
+3 SET (DIC,DIE)=$$DIC^XBSFGBL(90051.1101601)
+4 SET DA(2)=+BARCB
+5 SET DA(1)=+BARITM
+6 SET DA=+BARSUB
+7 SET BARUN(5)=$$VALI^XBDIQ1(DIC,.DA,5)
+8 SET DR="5////^S X=BARUN(5)+BARPMT"
+9 SET DIDEL=90050
+10 DO ^DIE
+11 KILL DIDEL
+12 ; -------------------------------
+13 ;
ILVL ;
+1 ; ** item level
+2 SET (DIC,DIE)=$$DIC^XBSFGBL(90051.1101)
+3 SET DA(1)=+BARCB
+4 SET DA=+BARITM
+5 SET BARUN("ACCT")=$$VALI^XBDIQ1(DIC,.DA,7)
+6 IF $GET(BARSUB)
QUIT
+7 SET BARUN(105)=$$VALI^XBDIQ1(DIC,.DA,105)
+8 SET DR="105////^S X=BARUN(105)+BARPMT"
+9 SET DIDEL=90050
+10 DO ^DIE
+11 KILL DIDEL
+12 QUIT
+13 ; *********************************************************************
+14 ;
BLVL ;
+1 ; ** batch level
+2 ;
TX ;** create transaction
+1 ;IHS/SD/TPF BAR*1.8*21 8/3/2011 HEAT20490
+2 ;IS SESSION STILL OPEN
IF $$NOTOPEN^BARUFUT(.DUZ,$GET(UFMSESID))
QUIT
+3 NEW DIC,BARCR,BARAC,BARTT
+4 SET DIE="^BARTR(DUZ(2),"
+5 SET DIC(0)="LX"
+6 KILL DO,DD
+7 SET BARCR=BARUN("AMT")
+8 SET BARAC=BARUN("ACCT")
+9 SET BARTT=$ORDER(^BARTBL("B","UN-ALLOCATED",0))
+10 ; -------------------------------
+11 ;
PX ;
+1 SET X=$$NEW^BARTR
+2 SET BARTRIEN=X
+3 IF BARTRIEN<1
Begin DoDot:1
+4 WRITE !!,"The system could not create an UN-ALLOCATED transaction. Please try again.",!
End DoDot:1
QUIT
+5 SET DA=X
+6 SET DR="2////^S X=BARCR"
+7 SET DR=DR_";6////^S X=BARAC"
+8 SET DR=DR_";12////^S X=DT"
+9 SET DR=DR_";13////^S X=DUZ"
+10 SET DR=DR_";14////^S X=BARCB"
+11 SET DR=DR_";101////^S X=BARTT"
+12 SET DR=DR_";15////^S X=BARITM"
+13 SET DR=DR_";105////^S X=""O"""
+14 SET DR=DR_";104////^S X=1"
+15 SET DR=DR_";10////^S X=$$VALI^XBDIQ1(200,DUZ,29)"
+16 ; HEAT348817 - IHS/SD/CPC - 20170829
IF $DATA(BAREOB)
SET DR=DR_";11////^S X=BAREOB"
+17 SET DIDEL=90050
+18 DO ^DIE
+19 KILL DIDEL
+20 ;
+21 ;BAR*1.8*3 UFMS
SET X=$$TRANTRIG^BARUFUT(DUZ,UFMSESID,BARTRIEN)
+22 QUIT
