BARCBTR.m

BARCBTR ; IHS/SD/LSL - COLLECTION BATCH CLOSING TRANSACTIONS DEC 4,1996 ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**23**;OCT 26, 2005

 ;

 ; IHS/SD/LSL - 12/05/02 - V1.7 - QAA-1200-130051

 ;     Added quit logic if error in getting new transaction.

 ;     Also split lines for readability and removed unused code

 ; 5-SEP-2012 HEAT# 82979 P.OTTIS BUG FIX

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

 ;;

EN(BARCBDA)        ;EP COLLECTION BATCH DA

 N BAR,BARCB,BARIT,BARITS,BARCOL,BARERROR

 S BARERROR=0

 ; A/R COLLECTION BATCH data elements

 D ENP^XBDIQ1(90051.01,BARCBDA,".01;3;8;10;15;18;20","BARCB(","I")

 I BARCB(3)'["POST" Q

 I BARCB(20)="COMPLETED" Q

 S BARCOL=$$GET1^DIQ(90051.01,BARCBDA,.01)

 ;** gather all items from subfile

 D ENPM^XBDIQ1(90051.1101,"BARCBDA,0",17,"BARITS(") ; item status

 ;** walk down all items

 S BARITDA=0

 F  S BARITDA=$O(BARITS(BARITDA)) Q:BARITDA'>0  D ITEM

 ; -------------------------------

 ;

 ;** set transmission status to complete

 Q:+BARERROR                ; not all transaction got created

 K DR,DA,DIE

 S DIE=$$DIC^XBDIQ1(90051.01)

 S DA=BARCBDA

 S DR="20////1"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 Q

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

 ;

ITEM ;** process item

 I $E(IOST)="C",IOT["TRM" W "."

 I "E"'[$E(BARITS(BARITDA,17)) Q  ; do not process non-EOBs

 N BART,BARS

 ;** get item demographics

 D ENP^XBDIQ1(90051.1101,"BARCBDA,BARITDA","4:7;17;101;201;203","BARIT(","I")

 ;** set tr basic demographics

 K DR,DA,DIE

 S DR=";4////^S X=BARIT(6,""I"")"

 S DR=DR_";5////^S X=BARIT(5,""I"")"

 S DR=DR_";8////^S X=BARCB(8,""I"")"

 S DR=DR_";10////^S X=BARCB(10,""I"")"

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

 S DR=DR_";14////^S X=BARCBDA"

 S DR=DR_";15////^S X=BARITDA"

 I BARIT(6) S DR=DR_";16////^S X=$$VALI^XBDIQ1(90050.01,BARIT(6,""I""),4)"

 S DR=DR_";205///^S X=BARIT(201)"

 S BARDR=DR

 ; -------------------------------

 ;

CB2ACP ;** cb>acp  TR account postable

 K DR,DA,DIE

 I BARIT(7,"I")="" D  Q  ;P.OTT

 . S BARERROR=1

 . S BARTTYPE="COL BAT TO ACC POST"

 . D MSG1

 . QUIT

 S DR="101///115"

 S DR=DR_";2///^S X=BARIT(101)"

 S DR=DR_";6////^S X=BARIT(7,""I"")"

 D TRSET

 I BARTR<1 D  Q

 . S BARERROR=1

 . S BARTTYPE="COL BAT TO ACC POST"

 . D MSG

 . H 2

 ;** ac postable amount

 S DIE=90050.02

 S DA=BARIT(7,"I")

 S DR="302///^S X=$$VAL^XBDIQ1(DIE,DA,302)+BARIT(101)"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 D TRFLAG

 ; -------------------------------

 ; Collection batch to facility account

 ;** get subs

 D ENPM^XBDIQ1(90051.1101601,"BARCBDA,BARITDA,0",".01;2","BARS(")

 ;all facilities in the parent satellite file are to have accounts

 S BARSDA=0 F  S BARSDA=$O(BARS(BARSDA)) Q:BARSDA'>0  D FACILITY

 Q

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

 ;

FACILITY ;** set tr  & account updates

 S X="L."_BARS(BARSDA,.01)

 S DIC(0)="XLM"

 S DIC=90050.02

 D ^DIC

 I Y'>0 D  Q

 . W !,*7,BARS(BARSDA,.01)

 . W " NOT IN THE ACCOUNT FILE!",!

 . H 5

 S BARACDA=+Y

 K DR,DA,DIE

 S DR="101////117"

 S DR=DR_";2///^S X=BARS(BARSDA,2)"

 S DR=DR_";6////^S X=BARACDA"

 S DR=DR_";11////^S X=BARSDA"

 D TRSET

 I BARTR<1 D  Q

 . S BARERROR=1

 . S BARTTYPE="COL BAT TO FACILITY"

 . D MSG

 . H 2

 ;** update loc account

 K DR,DA,DIE

 S DA=BARACDA

 S DIE=90050.02

 S DR="301///^S X=$$VAL^XBDIQ1(DIE,DA,301)+BARS(BARSDA,2)"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 D TRFLAG

 Q

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

 ;------------------   SUB ROUTINES CALLED  -------------------

 ;

TRSET ;** set transaction into A/R TRANSACTIONS/IHS data file

 S DR=DR_BARDR

 S (DA,BARTR)=$$NEW^BARTR

 Q:BARTR<1

 S DIE=90050.03

 S DIDEL=90050

 D ^DIE

 K DIDEL

 Q

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

 ;

TRFLAG ;** complete tr

 K DR,DA,DIE

 S DA=BARTR

 S DIE=90050.03

 S DR="104////1"

 S DIDEL=90050

 D ^DIE

 K DIDEL

 Q

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

 ;

DSPAC(DA)          ;** display an account

 N BART,I

 D ENP^XBDIQ1(90050.02,DA,".01;301:305","BART(")

 S I=""

 F  S I=$O(BART(I)) Q:I'>0  W !,I,?7,BART(I),?19,$P(^DD(90050.02,I,0),U)

 D EOP^BARUTL(0)

EDSPAC Q

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

MSG ;

 I $E(IOST)="C",IOT["TRM" D

 . W !,*7,$$CJ^XLFSTR("Could not create "_BARTTYPE_" transaction in A/R Transaction File.")

 . W !,$$CJ^XLFSTR("Please verify "_BARCOL_" item "_BARITDA_" closed properly.")

 Q

MSG1     ;

 I $E(IOST)="C",IOT["TRM" D

 . W !,*7,$$CJ^XLFSTR("Could not create "_BARTTYPE_" transaction in A/R Transaction File.")

 . W !,$$CJ^XLFSTR("BARIT(7,'I') = <nil> Please verify "_BARCOL_" item "_BARITDA_" closed properly.")

 Q  ;EOR

BARCBTR   ; IHS/SD/LSL - COLLECTION BATCH CLOSING TRANSACTIONS DEC 4,1996 ;

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

 +2       ;

 +3       ; IHS/SD/LSL - 12/05/02 - V1.7 - QAA-1200-130051

 +4       ;     Added quit logic if error in getting new transaction.

 +5       ;     Also split lines for readability and removed unused code

 +6       ; 5-SEP-2012 HEAT# 82979 P.OTTIS BUG FIX

 +7       ; *********************************************************************

 +8       ;;

EN(BARCBDA) ;EP COLLECTION BATCH DA

 +1        NEW BAR,BARCB,BARIT,BARITS,BARCOL,BARERROR

 +2        SET BARERROR=0

 +3       ; A/R COLLECTION BATCH data elements

 +4        DO ENP^XBDIQ1(90051.01,BARCBDA,".01;3;8;10;15;18;20","BARCB(","I")

 +5        IF BARCB(3)'["POST"

               QUIT 

 +6        IF BARCB(20)="COMPLETED"

               QUIT 

 +7        SET BARCOL=$$GET1^DIQ(90051.01,BARCBDA,.01)

 +8       ;** gather all items from subfile

 +9       ; item status

           DO ENPM^XBDIQ1(90051.1101,"BARCBDA,0",17,"BARITS(")

 +10      ;** walk down all items

 +11       SET BARITDA=0

 +12       FOR 

               SET BARITDA=$ORDER(BARITS(BARITDA))

               IF BARITDA'>0

                   QUIT 

               DO ITEM

 +13      ; -------------------------------

 +14      ;

 +15      ;** set transmission status to complete

 +16      ; not all transaction got created

           IF +BARERROR

               QUIT 

 +17       KILL DR,DA,DIE

 +18       SET DIE=$$DIC^XBDIQ1(90051.01)

 +19       SET DA=BARCBDA

 +20       SET DR="20////1"

 +21       SET DIDEL=90050

 +22       DO ^DIE

 +23       KILL DIDEL

 +24       QUIT 

 +25      ; *********************************************************************

 +26      ;

ITEM      ;** process item

 +1        IF $EXTRACT(IOST)="C"

               IF IOT["TRM"

                   WRITE "."

 +2       ; do not process non-EOBs

           IF "E"'[$EXTRACT(BARITS(BARITDA,17))

               QUIT 

 +3        NEW BART,BARS

 +4       ;** get item demographics

 +5        DO ENP^XBDIQ1(90051.1101,"BARCBDA,BARITDA","4:7;17;101;201;203","BARIT(","I")

 +6       ;** set tr basic demographics

 +7        KILL DR,DA,DIE

 +8        SET DR=";4////^S X=BARIT(6,""I"")"

 +9        SET DR=DR_";5////^S X=BARIT(5,""I"")"

 +10       SET DR=DR_";8////^S X=BARCB(8,""I"")"

 +11       SET DR=DR_";10////^S X=BARCB(10,""I"")"

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

 +13       SET DR=DR_";14////^S X=BARCBDA"

 +14       SET DR=DR_";15////^S X=BARITDA"

 +15       IF BARIT(6)

               SET DR=DR_";16////^S X=$$VALI^XBDIQ1(90050.01,BARIT(6,""I""),4)"

 +16       SET DR=DR_";205///^S X=BARIT(201)"

 +17       SET BARDR=DR

 +18      ; -------------------------------

 +19      ;

CB2ACP    ;** cb>acp  TR account postable

 +1        KILL DR,DA,DIE

 +2       ;P.OTT

           IF BARIT(7,"I")=""

               Begin DoDot:1

 +3                SET BARERROR=1

 +4                SET BARTTYPE="COL BAT TO ACC POST"

 +5                DO MSG1

 +6                QUIT 

               End DoDot:1

               QUIT 

 +7        SET DR="101///115"

 +8        SET DR=DR_";2///^S X=BARIT(101)"

 +9        SET DR=DR_";6////^S X=BARIT(7,""I"")"

 +10       DO TRSET

 +11       IF BARTR<1

               Begin DoDot:1

 +12               SET BARERROR=1

 +13               SET BARTTYPE="COL BAT TO ACC POST"

 +14               DO MSG

 +15               HANG 2

               End DoDot:1

               QUIT 

 +16      ;** ac postable amount

 +17       SET DIE=90050.02

 +18       SET DA=BARIT(7,"I")

 +19       SET DR="302///^S X=$$VAL^XBDIQ1(DIE,DA,302)+BARIT(101)"

 +20       SET DIDEL=90050

 +21       DO ^DIE

 +22       KILL DIDEL

 +23       DO TRFLAG

 +24      ; -------------------------------

 +25      ; Collection batch to facility account

 +26      ;** get subs

 +27       DO ENPM^XBDIQ1(90051.1101601,"BARCBDA,BARITDA,0",".01;2","BARS(")

 +28      ;all facilities in the parent satellite file are to have accounts

 +29       SET BARSDA=0

           FOR 

               SET BARSDA=$ORDER(BARS(BARSDA))

               IF BARSDA'>0

                   QUIT 

               DO FACILITY

 +30       QUIT 

 +31      ; *********************************************************************

 +32      ;

FACILITY  ;** set tr  & account updates

 +1        SET X="L."_BARS(BARSDA,.01)

 +2        SET DIC(0)="XLM"

 +3        SET DIC=90050.02

 +4        DO ^DIC

 +5        IF Y'>0

               Begin DoDot:1

 +6                WRITE !,*7,BARS(BARSDA,.01)

 +7                WRITE " NOT IN THE ACCOUNT FILE!",!

 +8                HANG 5

               End DoDot:1

               QUIT 

 +9        SET BARACDA=+Y

 +10       KILL DR,DA,DIE

 +11       SET DR="101////117"

 +12       SET DR=DR_";2///^S X=BARS(BARSDA,2)"

 +13       SET DR=DR_";6////^S X=BARACDA"

 +14       SET DR=DR_";11////^S X=BARSDA"

 +15       DO TRSET

 +16       IF BARTR<1

               Begin DoDot:1

 +17               SET BARERROR=1

 +18               SET BARTTYPE="COL BAT TO FACILITY"

 +19               DO MSG

 +20               HANG 2

               End DoDot:1

               QUIT 

 +21      ;** update loc account

 +22       KILL DR,DA,DIE

 +23       SET DA=BARACDA

 +24       SET DIE=90050.02

 +25       SET DR="301///^S X=$$VAL^XBDIQ1(DIE,DA,301)+BARS(BARSDA,2)"

 +26       SET DIDEL=90050

 +27       DO ^DIE

 +28       KILL DIDEL

 +29       DO TRFLAG

 +30       QUIT 

 +31      ; *********************************************************************

 +32      ;------------------   SUB ROUTINES CALLED  -------------------

 +33      ;

TRSET     ;** set transaction into A/R TRANSACTIONS/IHS data file

 +1        SET DR=DR_BARDR

 +2        SET (DA,BARTR)=$$NEW^BARTR

 +3        IF BARTR<1

               QUIT 

 +4        SET DIE=90050.03

 +5        SET DIDEL=90050

 +6        DO ^DIE

 +7        KILL DIDEL

 +8        QUIT 

 +9       ; *********************************************************************

 +10      ;

TRFLAG    ;** complete tr

 +1        KILL DR,DA,DIE

 +2        SET DA=BARTR

 +3        SET DIE=90050.03

 +4        SET DR="104////1"

 +5        SET DIDEL=90050

 +6        DO ^DIE

 +7        KILL DIDEL

 +8        QUIT 

 +9       ; *********************************************************************

 +10      ;

DSPAC(DA) ;** display an account

 +1        NEW BART,I

 +2        DO ENP^XBDIQ1(90050.02,DA,".01;301:305","BART(")

 +3        SET I=""

 +4        FOR 

               SET I=$ORDER(BART(I))

               IF I'>0

                   QUIT 

               WRITE !,I,?7,BART(I),?19,$PIECE(^DD(90050.02,I,0),U)

 +5        DO EOP^BARUTL(0)

EDSPAC     QUIT 

 +1       ; *********************************************************************

MSG       ;

 +1        IF $EXTRACT(IOST)="C"

               IF IOT["TRM"

                   Begin DoDot:1

 +2                    WRITE !,*7,$$CJ^XLFSTR("Could not create "_BARTTYPE_" transaction in A/R Transaction File.")

 +3                    WRITE !,$$CJ^XLFSTR("Please verify "_BARCOL_" item "_BARITDA_" closed properly.")

                   End DoDot:1

 +4        QUIT 

MSG1      ;

 +1        IF $EXTRACT(IOST)="C"

               IF IOT["TRM"

                   Begin DoDot:1

 +2                    WRITE !,*7,$$CJ^XLFSTR("Could not create "_BARTTYPE_" transaction in A/R Transaction File.")

 +3                    WRITE !,$$CJ^XLFSTR("BARIT(7,'I') = <nil> Please verify "_BARCOL_" item "_BARITDA_" closed properly.")

                   End DoDot:1

 +4       ;EOR

           QUIT