Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARCBC

BARCBC.m

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