BARCBC ; IHS/SD/LSL - CALCULATE COLLECTION BATCH FIELDS ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**3**;OCT 26, 2005
;
; ITSC/SD/LSL - 05/16/02 - V1.6 Patch 2 - NOIS CXX-0501-110068
; Modified to accomodate new field (23) in A/R Collection Batch
;
; ITSC/SD/LSL - 01/02/03 - V1.7 - BXX-0103-150002
; Modified L2 to not include cancelled items in batch total
;
; IHS/SD/LSL - 02/25/04 - V1.7 Patch 5 - IM12590
; Modified L2 to not include rolled up items in batch total
;
; *********************************************************************
;
B15(X) ;EP - batch total field #15
D L2
Q BARTOT(3)
; *********************************************************************
;
BTAL(X) ;batch total for all transaction types
;x=batch
S BARTOT1=0
N I
S I=0
F S I=$O(^BARTR(DUZ(2),"ACB",X,I)) Q:'I D
.N J
.S J=0
.F S J=$O(^BARTR(DUZ(2),"ACB",X,I,J)) Q:'J D
..S BARTOT1=BARTOT1+$$BTT(X,J)
Q BARTOT1
; *********************************************************************
;
BTT(X,Z) ;EP - batch total for given transaction type
;x=batch
;z=transaction type internal or external value
S BARTT1=Z
S:'BARTT1 BARTT1=$O(^BARTBL("B",BARTT1,0))
I 'BARTT1 K BARTT1 Q 0
S BARTOT2=0
N I
S I=0
F S I=$O(^BARTR(DUZ(2),"ACB",X,I)) Q:'I D
.S BARTOT2=BARTOT2+$$ITT(X,I,BARTT1)
K BARTT1
Q BARTOT2
; *********************************************************************
;IHS/SD/TPF BAR*1.8*3 UFMS SCR2
BTTREIM(COLIEN) ;EP - RETURN BATCH TOTAL FOR ALL REIMBURSEMENT TYPES
N BARTOTAL,BARTRANT
S BARTABT=23 ;THIS SHOULD EQUAL THE A/R TABLE TYPE ENTRY FOR 'UNBILLED REIMBURSEMENTS'
S BARTOTAL=0
S BARTRANT=""
F S BARTRANT=$O(^BARTBL("D",BARTABT,BARTRANT)) Q:'BARTRANT D
.S BARTOTAL=BARTOTAL+$$BTT(COLIEN,BARTRANT)
Q BARTOTAL
;
ITTREIM(COLIEN,ITEMIEN) ;EP - RETURN ITEM TOTAL FOR ALL REIMBURSEMENT TYPES
N BARTOTAL,BARTRANT
S BARTABT=23 ;THIS SHOULD EQUAL THE A/R TABLE TYPE ENTRY FOR 'UNBILLED REIMBURSEMENTS'
S BARTOTAL=0
S BARTRANT=""
F S BARTRANT=$O(^BARTBL("D",BARTABT,BARTRANT)) Q:'BARTRANT D
.S BARTOTAL=BARTOTAL+$$ITT(COLIEN,ITEMIEN,BARTRANT)
Q BARTOTAL
;
ITT(X,Y,Z) ;EP - item total for given transaction type
;x=batch
;y=item
;z=transaction type
S BARTT=Z
S:'BARTT BARTT=$O(^BARTBL("B",BARTT,0))
I 'BARTT K BARTT Q 0
D IL1
K BARTT
Q BARTOT
; *********************************************************************
;
STT(X,Y,Z,V) ;EP - sub EOB total for given transaction type
;x=batch
;y=item
;z=transaction type
;v=visit location
S BARTT=Z
S:'BARTT BARTT=$O(^BARTBL("B",BARTT,0))
I 'BARTT K BARTT Q 0
S BARVL=V
I 'BARVL K BARTT,BARVL Q 0
D IL1
K BARVL,BARTT
Q BARTOT
; *********************************************************************
;
IL1 ;for given item, loop thru transactions
S BARTOT=0
N J
S J=0
F S J=$O(^BARTR(DUZ(2),"ACB",X,Y,BARTT,J)) Q:'J D
.I $G(BARVL),$P(^BARTR(DUZ(2),J,0),"^",11)'=BARVL Q
. ;IF CALLED FROM FIELD 23, TRAN TYPE = UN-ALLOCATED AND GL STATUS=RESOLVED
. I +$G(BAR23),BARTT=100,$P($G(^BARTR(DUZ(2),J,1)),U,5)="R" Q
.S BARTOT=BARTOT+$P(^BARTR(DUZ(2),J,0),"^",2)
.S BARTOT=BARTOT-$P(^BARTR(DUZ(2),J,0),"^",3)
Q
; *********************************************************************
;
ITAL(X,Y) ;item total all transaction types
;x=batch
;y=item
S BARTOT3=0
N I
S I=0
F S I=$O(^BARTR(DUZ(2),"ACB",X,Y,I)) Q:'I D
.S BARTOT3=BARTOT3+$$ITT(X,Y,I)
Q BARTOT3
; *********************************************************************
;
L2 ;loop thru items in a batch
N I
F I=1:1:3 S BARTOT(I)=0
S I=0
F S I=$O(^BARCOL(DUZ(2),D0,1,I)) Q:'I D
.Q:$P($G(^BARCOL(DUZ(2),D0,1,I,0)),U,17)="C"
. Q:$P($G(^BARCOL(DUZ(2),D0,1,I,0)),U,17)="R" ; Quit if rolled up
.S BAR1=$G(^BARCOL(DUZ(2),D0,1,I,1))
.S BARTOT(1)=BARTOT(1)+$P(BAR1,"^",1)
.S BARTOT(2)=BARTOT(2)+$P(BAR1,"^",2)
S BARTOT(3)=BARTOT(1)-BARTOT(2)
Q
; *********************************************************************
;
SET(X,Y) ;EP - sub eob total, field #202
;x=batch
;y=item
S BARST=0
N I
S I=0
F S I=$O(^BARCOL(DUZ(2),X,1,Y,6,I)) Q:'I D
.S BARST=BARST+$P(^BARCOL(DUZ(2),X,1,Y,6,I,0),"^",2)
Q BARST
BARCBC ; IHS/SD/LSL - CALCULATE COLLECTION BATCH FIELDS ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3**;OCT 26, 2005
+2 ;
+3 ; ITSC/SD/LSL - 05/16/02 - V1.6 Patch 2 - NOIS CXX-0501-110068
+4 ; Modified to accomodate new field (23) in A/R Collection Batch
+5 ;
+6 ; ITSC/SD/LSL - 01/02/03 - V1.7 - BXX-0103-150002
+7 ; Modified L2 to not include cancelled items in batch total
+8 ;
+9 ; IHS/SD/LSL - 02/25/04 - V1.7 Patch 5 - IM12590
+10 ; Modified L2 to not include rolled up items in batch total
+11 ;
+12 ; *********************************************************************
+13 ;
B15(X) ;EP - batch total field #15
+1 DO L2
+2 QUIT BARTOT(3)
+3 ; *********************************************************************
+4 ;
BTAL(X) ;batch total for all transaction types
+1 ;x=batch
+2 SET BARTOT1=0
+3 NEW I
+4 SET I=0
+5 FOR
SET I=$ORDER(^BARTR(DUZ(2),"ACB",X,I))
IF 'I
QUIT
Begin DoDot:1
+6 NEW J
+7 SET J=0
+8 FOR
SET J=$ORDER(^BARTR(DUZ(2),"ACB",X,I,J))
IF 'J
QUIT
Begin DoDot:2
+9 SET BARTOT1=BARTOT1+$$BTT(X,J)
End DoDot:2
End DoDot:1
+10 QUIT BARTOT1
+11 ; *********************************************************************
+12 ;
BTT(X,Z) ;EP - batch total for given transaction type
+1 ;x=batch
+2 ;z=transaction type internal or external value
+3 SET BARTT1=Z
+4 IF 'BARTT1
SET BARTT1=$ORDER(^BARTBL("B",BARTT1,0))
+5 IF 'BARTT1
KILL BARTT1
QUIT 0
+6 SET BARTOT2=0
+7 NEW I
+8 SET I=0
+9 FOR
SET I=$ORDER(^BARTR(DUZ(2),"ACB",X,I))
IF 'I
QUIT
Begin DoDot:1
+10 SET BARTOT2=BARTOT2+$$ITT(X,I,BARTT1)
End DoDot:1
+11 KILL BARTT1
+12 QUIT BARTOT2
+13 ; *********************************************************************
+14 ;IHS/SD/TPF BAR*1.8*3 UFMS SCR2
BTTREIM(COLIEN) ;EP - RETURN BATCH TOTAL FOR ALL REIMBURSEMENT TYPES
+1 NEW BARTOTAL,BARTRANT
+2 ;THIS SHOULD EQUAL THE A/R TABLE TYPE ENTRY FOR 'UNBILLED REIMBURSEMENTS'
SET BARTABT=23
+3 SET BARTOTAL=0
+4 SET BARTRANT=""
+5 FOR
SET BARTRANT=$ORDER(^BARTBL("D",BARTABT,BARTRANT))
IF 'BARTRANT
QUIT
Begin DoDot:1
+6 SET BARTOTAL=BARTOTAL+$$BTT(COLIEN,BARTRANT)
End DoDot:1
+7 QUIT BARTOTAL
+8 ;
ITTREIM(COLIEN,ITEMIEN) ;EP - RETURN ITEM TOTAL FOR ALL REIMBURSEMENT TYPES
+1 NEW BARTOTAL,BARTRANT
+2 ;THIS SHOULD EQUAL THE A/R TABLE TYPE ENTRY FOR 'UNBILLED REIMBURSEMENTS'
SET BARTABT=23
+3 SET BARTOTAL=0
+4 SET BARTRANT=""
+5 FOR
SET BARTRANT=$ORDER(^BARTBL("D",BARTABT,BARTRANT))
IF 'BARTRANT
QUIT
Begin DoDot:1
+6 SET BARTOTAL=BARTOTAL+$$ITT(COLIEN,ITEMIEN,BARTRANT)
End DoDot:1
+7 QUIT BARTOTAL
+8 ;
ITT(X,Y,Z) ;EP - item total for given transaction type
+1 ;x=batch
+2 ;y=item
+3 ;z=transaction type
+4 SET BARTT=Z
+5 IF 'BARTT
SET BARTT=$ORDER(^BARTBL("B",BARTT,0))
+6 IF 'BARTT
KILL BARTT
QUIT 0
+7 DO IL1
+8 KILL BARTT
+9 QUIT BARTOT
+10 ; *********************************************************************
+11 ;
STT(X,Y,Z,V) ;EP - sub EOB total for given transaction type
+1 ;x=batch
+2 ;y=item
+3 ;z=transaction type
+4 ;v=visit location
+5 SET BARTT=Z
+6 IF 'BARTT
SET BARTT=$ORDER(^BARTBL("B",BARTT,0))
+7 IF 'BARTT
KILL BARTT
QUIT 0
+8 SET BARVL=V
+9 IF 'BARVL
KILL BARTT,BARVL
QUIT 0
+10 DO IL1
+11 KILL BARVL,BARTT
+12 QUIT BARTOT
+13 ; *********************************************************************
+14 ;
IL1 ;for given item, loop thru transactions
+1 SET BARTOT=0
+2 NEW J
+3 SET J=0
+4 FOR
SET J=$ORDER(^BARTR(DUZ(2),"ACB",X,Y,BARTT,J))
IF 'J
QUIT
Begin DoDot:1
+5 IF $GET(BARVL)
IF $PIECE(^BARTR(DUZ(2),J,0),"^",11)'=BARVL
QUIT
+6 ;IF CALLED FROM FIELD 23, TRAN TYPE = UN-ALLOCATED AND GL STATUS=RESOLVED
+7 IF +$GET(BAR23)
IF BARTT=100
IF $PIECE($GET(^BARTR(DUZ(2),J,1)),U,5)="R"
QUIT
+8 SET BARTOT=BARTOT+$PIECE(^BARTR(DUZ(2),J,0),"^",2)
+9 SET BARTOT=BARTOT-$PIECE(^BARTR(DUZ(2),J,0),"^",3)
End DoDot:1
+10 QUIT
+11 ; *********************************************************************
+12 ;
ITAL(X,Y) ;item total all transaction types
+1 ;x=batch
+2 ;y=item
+3 SET BARTOT3=0
+4 NEW I
+5 SET I=0
+6 FOR
SET I=$ORDER(^BARTR(DUZ(2),"ACB",X,Y,I))
IF 'I
QUIT
Begin DoDot:1
+7 SET BARTOT3=BARTOT3+$$ITT(X,Y,I)
End DoDot:1
+8 QUIT BARTOT3
+9 ; *********************************************************************
+10 ;
L2 ;loop thru items in a batch
+1 NEW I
+2 FOR I=1:1:3
SET BARTOT(I)=0
+3 SET I=0
+4 FOR
SET I=$ORDER(^BARCOL(DUZ(2),D0,1,I))
IF 'I
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^BARCOL(DUZ(2),D0,1,I,0)),U,17)="C"
QUIT
+6 ; Quit if rolled up
IF $PIECE($GET(^BARCOL(DUZ(2),D0,1,I,0)),U,17)="R"
QUIT
+7 SET BAR1=$GET(^BARCOL(DUZ(2),D0,1,I,1))
+8 SET BARTOT(1)=BARTOT(1)+$PIECE(BAR1,"^",1)
+9 SET BARTOT(2)=BARTOT(2)+$PIECE(BAR1,"^",2)
End DoDot:1
+10 SET BARTOT(3)=BARTOT(1)-BARTOT(2)
+11 QUIT
+12 ; *********************************************************************
+13 ;
SET(X,Y) ;EP - sub eob total, field #202
+1 ;x=batch
+2 ;y=item
+3 SET BARST=0
+4 NEW I
+5 SET I=0
+6 FOR
SET I=$ORDER(^BARCOL(DUZ(2),X,1,Y,6,I))
IF 'I
QUIT
Begin DoDot:1
+7 SET BARST=BARST+$PIECE(^BARCOL(DUZ(2),X,1,Y,6,I,0),"^",2)
End DoDot:1
+8 QUIT BARST
