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

IB20P620.m

Go to the documentation of this file.
  1. IB20P620 ;MNT/BJR - POST-INIT FOR IB*2.0*620 ;Mar 8,2018@8:29am
  1. ;;2.0;INTEGRATED BILLING;**620**;21-MAR-94;Build 1
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. THRESH ; Pension Threshold
  1. N IBA,IBERRM,IBRN,IBTYPE,IBX,DA,DIK,IBADLDEP
  1. S IBTYPE="Pension Threshold"
  1. D BMES^XPDUTL("Filing CY 2017 Pension Threshold rates.")
  1. I $D(^IBE(354.3,"B",3161201)) D ; remove 12/01/2016 if exists befre filing
  1. . S IBRN=0
  1. . F S IBRN=$O(^IBE(354.3,"B",3161201,IBRN)) Q:'IBRN D
  1. .. S DIK="^IBE(354.3,",DA=IBRN D ^DIK
  1. S IBA(354.3,"+1,",.01)=3161201 ; effective date for CY 2017 values
  1. S IBA(354.3,"+1,",.02)=1 ; internal value 1 = BASIC PENSION
  1. S IBA(354.3,"+1,",.03)=12907 ; base rate for veteran
  1. S IBA(354.3,"+1,",.04)=16902 ; 1 dependent
  1. S IBADLDEP=2205 ; additional dependent amount
  1. F IBX=.05:.01:.11 S IBA(354.3,"+1,",IBX)=IBA(354.3,"+1,",IBX-.01)+IBADLDEP ;2 thru 8 dependents
  1. S IBA(354.3,"+1,",.12)=IBADLDEP ; additional dependent amount
  1. D UPDATE^DIE("","IBA","","IBERRM") ; file the new record for CY 2017
  1. I $D(IBERRM) D
  1. . D BMES^XPDUTL("Unable to file the new rates. The error message is as follows:")
  1. . S IBRN=0
  1. . F S IBRN=$O(IBERRM("DIERR",1,"TEXT",IBRN)) Q:IBRN="" D MES^XPDUTL(IBERRM("DIERR",1,"TEXT",IBRN))
  1. . D BMES^XPDUTL("Please check the database and then file the new rates manually.")
  1. . D MMSG
  1. E D COMPLETE
  1. Q
  1. ;
  1. MMSG ; MailMan message to report update problem to billing groups, patch installer and patch developer
  1. N DA,IBC,IBGROUP,IBPARAM,IBTXT,XMDUZ,XMSUB,XMTEXT,XMY
  1. S XMSUB="Integrated Billing Annual Rate Update Error"
  1. S XMDUZ=DUZ,XMTEXT="IBTXT"
  1. S IBPARAM("FROM")="PATCH IB*2.0*620 CY 2017 RATE UPDATE"
  1. F IBGROUP="IB EDI SUPERVISOR","IB ERROR","MCCR" D
  1. . I $D(^XMB(3.8,"B",IBGROUP)) S IBGROUP="G."_IBGROUP,XMY(IBGROUP)=""
  1. S XMY(DUZ)=""
  1. ;
  1. S IBC=0
  1. S IBC=IBC+1,IBTXT(IBC)="This message has been sent by patch IB*2.0*620. If you have received this"
  1. S IBC=IBC+1,IBTXT(IBC)="message, it indicates that the patch encountered some difficulty in filing"
  1. S IBC=IBC+1,IBTXT(IBC)="the CY 2017 "_IBTYPE_" rates as outlined in the patch description."
  1. S IBC=IBC+1,IBTXT(IBC)="Please verify the integrity of files 354.3 - BILLING THRESHOLDS and"
  1. S IBC=IBC+1,IBTXT(IBC)="350.2 - IB ACTION CHARGE and then enter the new rates manually."
  1. S IBC=IBC+1,IBTXT(IBC)="You can consult the IB*2.0*620 patch description for additional information."
  1. S IBC=IBC+1,IBTXT(IBC)=" "
  1. S IBC=IBC+1,IBTXT(IBC)="This action only needs to be done by one person. Please verify with the"
  1. S IBC=IBC+1,IBTXT(IBC)="appropriate billing supervisor that the update has been accomplished."
  1. D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.IBPARAM,"","")
  1. MMSGQ Q ; end of Mail Message subroutine
  1. ;
  1. COMPLETE ; display message that step has completed successfully
  1. D BMES^XPDUTL("Step complete.")
  1. Q
  1. ;