BARPST7.m

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