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
