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

PRCAI169.m

Go to the documentation of this file. 
  1. PRCAI169 ;WISC/RFJ-post init patch 169 ; 26 Jan 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
  1.  ;
  1.  D BMES^XPDUTL(" >>  Queuing the Post-Initialization routine ...")
  1.  ;
  1.  N ZTIO,ZTDTH,ZTRTN,ZTSK
  1.  S ZTIO="",ZTDTH=$H,ZTRTN="DQ^PRCAI169"
  1.  D ^%ZTLOAD
  1.  ;
  1.  D MES^XPDUTL("     in task "_ZTSK_".")
  1.  ;
  1.  D BMES^XPDUTL(" ")
  1.  D MES^XPDUTL("  IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT")
  1.  D MES^XPDUTL("  *********************************************************************")
  1.  D MES^XPDUTL("    When the Queued Post-Initialization finishes running, a mail")
  1.  D MES^XPDUTL("    message will be delivered to the mail groups IRM and PRCA")
  1.  D MES^XPDUTL("    ADJUSTMENT TRANS with the subject: AR Patch 169 Installation")
  1.  D MES^XPDUTL("    Completed.  You should receive this message within 24 hours.")
  1.  D MES^XPDUTL("    If you do not receive the message, you will need to restart")
  1.  D MES^XPDUTL("    the Post-Initialization by running the routine START^PRCAI169.")
  1.  D MES^XPDUTL("  *********************************************************************")
  1.  D MES^XPDUTL("  IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT  IMPORTANT")
  1.  Q
  1.  ;
  1.  ;
  1. DQ ;  queue post initialization
  1.  ;
  1.  ;  add the post install entry for history
  1.  N RCMSPOST
  1.  S RCMSPOST=$$START^RCMSPOST("PRCA*4.5*169")
  1.  ;
  1.  ;  1. ***** disable type of payment IRS PAYMENT by
  1.  ;  removing the category field entry .06
  1.  N %,D,D0,DA,DI,DIC,DIE,DQ,DR,X
  1.  S DA=$O(^RC(341.1,"B","IRS PAYMENT",0))
  1.  I DA S (DIC,DIE)="^RC(341.1,",DR=".06///@;" D ^DIE
  1.  ;
  1.  ;
  1.  ;  2. ***** delete IRS mail group
  1.  ;  reference to XMB allowed in integration agreement 3359
  1.  N %,DA,DIC,DIK,RCMIRSDA,RCDA,X,Y
  1.  S RCMIRSDA=+$O(^XMB(3.8,"B","IRS",0))
  1.  I RCMIRSDA D
  1.  .   ;  check to see if IRS mail group is a member of another
  1.  .   ;  mail group.  If so, delete it from the other mail group.
  1.  .   S RCDA(1)=0 F  S RCDA(1)=$O(^XMB(3.8,"AD",RCMIRSDA,RCDA(1))) Q:'RCDA(1)  D
  1.  .   .   S RCDA=0 F  S RCDA=$O(^XMB(3.8,"AD",RCMIRSDA,RCDA(1),RCDA)) Q:'RCDA  D
  1.  .   .   .   S DA(1)=RCDA(1),DA=RCDA,DIK="^XMB(3.8,"_RCDA(1)_",5,"
  1.  .   .   .   D ^DIK
  1.  .   ;
  1.  .   ;  delete the mail group
  1.  .   S DA=RCMIRSDA,DIK="^XMB(3.8,"
  1.  .   D ^DIK
  1.  ;
  1.  ;
  1.  ;  3. ***** fix ineligible bills, convert transaction type 24 to 02
  1.  N RCBILLDA,RCDATE
  1.  S RCDATE=3001000
  1.  F  S RCDATE=$O(^PRCA(430,"ACTDT",RCDATE)) Q:'RCDATE  D
  1.  .   S RCBILLDA=0 F  S RCBILLDA=$O(^PRCA(430,"ACTDT",RCDATE,RCBILLDA)) Q:'RCBILLDA  D
  1.  .   .   ;  if not an ineligible bill, quit
  1.  .   .   I $P($G(^PRCA(430,RCBILLDA,0)),"^",2)'=1 Q
  1.  .   .   ;  if the tranasaction type already equals 02, quit
  1.  .   .   I $P($G(^PRCA(430,RCBILLDA,11)),"^",10)=02 Q
  1.  .   .   S $P(^PRCA(430,RCBILLDA,11),"^",10)="02"
  1.  ;
  1.  ;
  1.  ;  4. ***** fix exemptions where the transaction is not split between
  1.  ;           interest and admin
  1.  D START^PRCAI16A
  1.  ;
  1.  ;
  1.  ;  5. ***** fix exemption date problem
  1.  ;  build a list of accounts out of balance at the site
  1.  N ACCTDATA,DATA,OUTOFBAL,RCDATE,RCDEBTDA,RCEXDATA,RCEXDATE,RCLINE,RCNEXT,RCPADATA,RCTOTAL1,RCTOTAL2,RCTRANDA,X,Y
  1.  K ^TMP("PRCAI169",$J)
  1.  ;
  1.  ;  build list of accounts out of balance
  1.  S RCDEBTDA=0
  1.  F  S RCDEBTDA=$O(^RCD(340,"AB","DPT(",RCDEBTDA)) Q:'RCDEBTDA  D
  1.  .   S OUTOFBAL=$$EN^PRCAMRKC(RCDEBTDA)
  1.  .   I OUTOFBAL S ^TMP("PRCAI169",$J,RCDEBTDA)=""
  1.  ;
  1.  ;  loop all transactions for debtor and look at the exempt charge.
  1.  ;  if the exempt transaction date is not equal to the payment
  1.  ;  transaction date, change the exempt charge date.
  1.  S RCDEBTDA=0
  1.  F  S RCDEBTDA=$O(^TMP("PRCAI169",$J,RCDEBTDA)) Q:'RCDEBTDA  D
  1.  .   ;  get the last statement date
  1.  .   S RCDATE=$P(+$$LST^RCFN01(RCDEBTDA,2),".")
  1.  .   ;
  1.  .   ;  loop all transactions up to the last statement date + 1 day
  1.  .   S RCEXDATE=0
  1.  .   F  S RCEXDATE=$O(^PRCA(433,"ATD",RCDEBTDA,RCEXDATE)) Q:'RCEXDATE!(RCEXDATE>(RCDATE+1))  D
  1.  .   .   S RCTRANDA=0
  1.  .   .   F  S RCTRANDA=$O(^PRCA(433,"ATD",RCDEBTDA,RCEXDATE,RCTRANDA)) Q:'RCTRANDA  D
  1.  .   .   .   ;  type of transaction is not an exemption
  1.  .   .   .   S RCEXDATA=$G(^PRCA(433,RCTRANDA,1))
  1.  .   .   .   I $P(RCEXDATA,"^",2)'=14 Q
  1.  .   .   .   ;
  1.  .   .   .   ;  get the next transaction for the bill
  1.  .   .   .   S RCNEXT=$O(^PRCA(433,"C",+$P($G(^PRCA(433,+RCTRANDA,0)),"^",2),RCTRANDA))
  1.  .   .   .   ;  is it a payment?, if no, quit
  1.  .   .   .   S RCPADATA=$G(^PRCA(433,+RCNEXT,1))
  1.  .   .   .   I $P(RCPADATA,"^",2)'=2,$P(RCPADATA,"^",2)'=34 Q
  1.  .   .   .   ;
  1.  .   .   .   ;  check to see if this is an automatic exemption,
  1.  .   .   .   ;  if not, then do not change the date
  1.  .   .   .   I $G(^PRCA(433,RCTRANDA,7,1,0))'["Auto" Q
  1.  .   .   .   ;
  1.  .   .   .   ;  it is a payment, if the date of the payment is greater
  1.  .   .   .   ;  than the date of the exemption by more than 1 minute,
  1.  .   .   .   ;  change the exemption date to be equal to the payment date
  1.  .   .   .   I ($P(RCPADATA,"^",9)-$P(RCEXDATA,"^",9))>.0001 S X=$$EDIT433^RCBEUTRA(RCTRANDA,"19////"_$P(RCPADATA,"^",9)_";")
  1.  ;
  1.  ;  recheck the accounts out of balance
  1.  S RCTOTAL1=0  ;used to count accts out of balance prior to install
  1.  S RCTOTAL2=0  ;used to count accts fixed by the patch
  1.  S RCDEBTDA=0
  1.  F  S RCDEBTDA=$O(^TMP("PRCAI169",$J,RCDEBTDA)) Q:'RCDEBTDA  D
  1.  .   ;  check to see if account has a bill in refund review.
  1.  .   ;  if it does, remove it from the list.
  1.  .   I $$REFUREVW^RCBEREFU(RCDEBTDA) K ^TMP("PRCAI169",$J,RCDEBTDA) Q
  1.  .   ;  original count of accounts out of balance before patch install
  1.  .   S RCTOTAL1=RCTOTAL1+1
  1.  .   ;  check to see if account is out of balance.  if it is
  1.  .   ;  not out of balance, remove it from the list.
  1.  .   S OUTOFBAL=$$EN^PRCAMRKC(RCDEBTDA)
  1.  .   I 'OUTOFBAL S RCTOTAL2=RCTOTAL2+1 K ^TMP("PRCAI169",$J,RCDEBTDA)
  1.  ;
  1.  ;  build mailman message showing patch installed and accounts still
  1.  ;  out of balance
  1.  K ^TMP($J,"RCRJRCORMM")
  1.  S ^TMP($J,"RCRJRCORMM",1)="The Post-Initialization routine for patch PRCA*4.5*169 is completed."
  1.  S ^TMP($J,"RCRJRCORMM",2)="Patch PRCA*4.5*169 has been completely installed."
  1.  S ^TMP($J,"RCRJRCORMM",3)=" "
  1.  S ^TMP($J,"RCRJRCORMM",4)="The following accounts are still out of balance after the patch install."
  1.  S ^TMP($J,"RCRJRCORMM",5)="This list excludes accounts with bills in refund review."
  1.  S ^TMP($J,"RCRJRCORMM",6)=" "
  1.  S RCLINE=6
  1.  S RCDEBTDA=0
  1.  F  S RCDEBTDA=$O(^TMP("PRCAI169",$J,RCDEBTDA)) Q:'RCDEBTDA  D
  1.  .   S ACCTDATA=$$ACCNTHDR^RCDPAPLM(RCDEBTDA)
  1.  .   S DATA=$E($P(ACCTDATA,"^")_"                              ",1,30)_"  "
  1.  .   S DATA=DATA_$E($P(ACCTDATA,"^",2)_"            ",1,12)_"  "
  1.  .   S DATA=DATA_$P(ACCTDATA,"^",3)
  1.  .   S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)=DATA
  1.  ;
  1.  S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)=" "
  1.  S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)="  TOTAL ACCOUNTS OUT OF BALANCE BEFORE PATCH INSTALL: "_$J(RCTOTAL1,8)
  1.  S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)="                       TOTAL ACCOUNTS FIXED BY PATCH: "_$J(RCTOTAL2,8)
  1.  S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)="                                                      "_$J("--------",8)
  1.  S RCLINE=RCLINE+1,^TMP($J,"RCRJRCORMM",RCLINE)="  TOTAL ACCOUNTS OUT OF BALANCE AFTER  PATCH INSTALL: "_$J((RCTOTAL1-RCTOTAL2),8)
  1.  ;
  1.  ;  send mail message
  1.  ;  difrom needs to be newed or mailman will not deliver the message
  1.  N DIFROM,XMDUN,XMY,XMZ
  1.  S XMY("G.IRM")=""
  1.  S XMY("G.PRCA ADJUSTMENT TRANS")=""
  1.  S XMY(.5)=""
  1.  S XMY(DUZ)=""
  1.  S XMZ=$$SENDMSG^RCRJRCOR("AR Patch 169 Installation Completed",.XMY)
  1.  K ^TMP($J,"RCRJRCORMM")
  1.  ;
  1.  K ^TMP("PRCAI169",$J)
  1.  ;
  1.  ;  set the end date for the post initialization
  1.  D END^RCMSPOST(RCMSPOST)
  1.  Q