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

PRCAI16A.m

Go to the documentation of this file. 
  1. PRCAI16A ;WISC/RFJ-post init patch 169 continued ; 1 Apr 01
  1.  ;;4.5;Accounts Receivable;**169**;Mar 20, 1995
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  Q
  1.  ;
  1.  ;
  1. START ;  start post init (fix exempt transactions)
  1.  ;  break out the exempt transaction to interest and admin
  1.  N RCDATE,RCTRANDA
  1.  ;
  1.  ;  start finding exempt transactions and fixing them
  1.  S RCDATE=9999999 F  S RCDATE=$O(^PRCA(433,"AT",14,RCDATE),-1) Q:'RCDATE  D
  1.  .   S RCTRANDA=999999999999999
  1.  .   F  S RCTRANDA=$O(^PRCA(433,"AT",14,RCDATE,RCTRANDA),-1) Q:'RCTRANDA  D FIXEXEM(RCTRANDA)
  1.  Q
  1.  ;
  1.  ;
  1. FIXEXEM(RCTRANDA) ;  fix an exempt charge
  1.  ;  if transaction status not valid, quit
  1.  I '$$VALID^RCRJRCOT(RCTRANDA) Q
  1.  ;
  1.  N ADMIN,BALANCE,CC,INTEREST,MF,RCBALANC,RCBILLDA,RCDATA7,RCLIST,TRANTOTL
  1.  ;
  1.  L +^PRCA(433,RCTRANDA)
  1.  ;
  1.  ;  if node 2 already breaks out the int/admin, quit
  1.  I $G(^PRCA(433,RCTRANDA,2))'="" L -^PRCA(433,RCTRANDA) Q
  1.  ;
  1.  S RCBILLDA=$P(^PRCA(433,RCTRANDA,0),"^",2)
  1.  ;  no bill on transaction
  1.  I 'RCBILLDA L -^PRCA(433,RCTRANDA) Q
  1.  ;
  1.  ;  lock the bill and get the current bill balance
  1.  L +^PRCA(430,RCBILLDA)
  1.  S RCBALANC=$$GETTRANS^RCDPBTLM(RCBILLDA)
  1.  S TRANTOTL=$P(^PRCA(433,RCTRANDA,1),"^",5) I 'TRANTOTL D UNLOCK Q
  1.  ;
  1.  ;  if the bill is in balance and the balance is zero,
  1.  ;  make the transaction all interest
  1.  I $TR($P(RCBALANC,"^",2,5),"^0")="",$$OUTOFBAL^RCBDBBAL(RCBILLDA)="" S $P(^PRCA(433,RCTRANDA,2),"^",7)=TRANTOTL D UNLOCK Q
  1.  ;
  1.  ;  if the interest balance is equal to the admin balance and
  1.  ;  the interest balance is zero, move to admin
  1.  I $P(RCBALANC,"^",2)<0,-$P(RCBALANC,"^",2)=$P(RCBALANC,"^",3) D  Q
  1.  .   S ADMIN=$P(RCBALANC,"^",3) I ADMIN>TRANTOTL S ADMIN=TRANTOTL
  1.  .   S INTEREST=TRANTOTL-ADMIN
  1.  .   S (MF,CC)=0
  1.  .   D SET
  1.  ;
  1.  ;  if the stored interest balance minus the calculated
  1.  ;  interest balance is equal to the transaction total
  1.  ;  of the exemption, then the exemption is
  1.  ;  for all admin.
  1.  S RCDATA7=$P($G(^PRCA(430,RCBILLDA,7)),"^",1,5)
  1.  I ($P(RCDATA7,"^",2)-$P(RCBALANC,"^",2))=TRANTOTL D  Q
  1.  .   S (INTEREST,MF,CC)=0
  1.  .   S ADMIN=TRANTOTL D SET
  1.  ;
  1.  ;  calculate the bills balance up to the exempt transaction
  1.  S BALANCE=$$CALCBAL(0,RCTRANDA-1)
  1.  ;
  1.  S (INTEREST,ADMIN,MF,CC)=""
  1.  S INTEREST=$P(BALANCE,"^",2) I INTEREST<0 S INTEREST=0
  1.  I INTEREST'<TRANTOTL S INTEREST=TRANTOTL D SET Q
  1.  ;
  1.  S ADMIN=$P(BALANCE,"^",3) I ADMIN<0 S ADMIN=0
  1.  I (INTEREST+ADMIN)'<TRANTOTL S ADMIN=TRANTOTL-INTEREST D SET Q
  1.  ;
  1.  S MF=$P(BALANCE,"^",4) I MF<0 S MF=0
  1.  I (INTEREST+ADMIN+MF)'<TRANTOTL S MF=TRANTOTL-INTEREST-ADMIN D SET Q
  1.  ;
  1.  S CC=$P(BALANCE,"^",5) I CC<0 S CC=0
  1.  I (INTEREST+ADMIN+MF+CC)'<TRANTOTL S CC=TRANTOTL-INTEREST-ADMIN-MF D SET Q
  1.  ;
  1.  ;  set as all interest
  1.  S INTEREST=TRANTOTL,(ADMIN,MF,CC)="" D SET
  1.  Q
  1.  ;
  1.  ;
  1. SET ;  set the exempt node
  1.  N DATA2
  1.  S DATA2=$G(^PRCA(433,RCTRANDA,2))
  1.  I INTEREST S $P(DATA2,"^",7)=INTEREST
  1.  I ADMIN S $P(DATA2,"^",8)=ADMIN
  1.  I MF S $P(DATA2,"^",5)=MF
  1.  I CC S $P(DATA2,"^",6)=CC
  1.  S ^PRCA(433,RCTRANDA,2)=DATA2
  1.  D UNLOCK
  1.  Q
  1.  ;
  1.  ;
  1. UNLOCK ;  unlock the transaction and bill
  1.  L -^PRCA(433,RCTRANDA)
  1.  L -^PRCA(430,RCBILLDA)
  1.  Q
  1.  ;
  1.  ;
  1. CALCBAL(RCDATE,RCTRANDA) ;  calculate a bills balance
  1.  ;  up to a certain date and/or transaction
  1.  ;    rclist(date,tranda) must be defined from calling
  1.  ;      gettrans^rcdpbtlm
  1.  ;
  1.  I 'RCDATE N RCDATE S RCDATE=9999999
  1.  I 'RCTRANDA N RCTRANDA S RCTRANDA=999999999999999
  1.  ;
  1.  N ADMBAL,CCBAL,DATE,INTBAL,MFBAL,PRINBAL,TRANDA,RCSTOP
  1.  S (PRINBAL,INTBAL,ADMBAL,MFBAL,CCBAL)=0
  1.  ;
  1.  S DATE="" F  S DATE=$O(RCLIST(DATE)) Q:DATE=""!($G(RCSTOP))  D
  1.  .   I $E(DATE,1,7)>$E(RCDATE,1,7) S RCSTOP=1 Q
  1.  .   ;
  1.  .   S TRANDA="" F  S TRANDA=$O(RCLIST(DATE,TRANDA)) Q:TRANDA=""  D
  1.  .   .   I TRANDA>RCTRANDA S RCSTOP=1 Q
  1.  .   .   ;
  1.  .   .   S PRINBAL=PRINBAL+$P(RCLIST(DATE,TRANDA),"^",2)
  1.  .   .   S INTBAL=INTBAL+$P(RCLIST(DATE,TRANDA),"^",3)
  1.  .   .   S ADMBAL=ADMBAL+$P(RCLIST(DATE,TRANDA),"^",4)
  1.  .   .   S MFBAL=MFBAL+$P(RCLIST(DATE,TRANDA),"^",5)
  1.  .   .   S CCBAL=CCBAL+$P(RCLIST(DATE,TRANDA),"^",6)
  1.  ;
  1.  Q PRINBAL_"^"_INTBAL_"^"_ADMBAL_"^"_MFBAL_"^"_CCBAL