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

IB20P465.m

Go to the documentation of this file.
  1. IB20P465 ;ALB/TDM - POST-INIT FOR IB*2.0*465 ; 11/17/11 10:57am
  1. ;;2.0;INTEGRATED BILLING;**465**;21-MAR-94;Build 5
  1. ;
  1. PRE ; set up check points for pre/post-init
  1. N %
  1. S %=$$NEWCP^XPDUTL("THRESH","THRESH^IB20P465")
  1. S %=$$NEWCP^XPDUTL("MCRDED","MCRDED^IB20P465")
  1. S %=$$NEWCP^XPDUTL("PRIOR","PRIOR^IB20P465")
  1. Q
  1. ;
  1. THRESH ; Pension Threshold
  1. N IBA,IBERRM,IBRN,IBTYPE,IBX,DA,DIK
  1. S IBTYPE="Pension Threshold"
  1. D BMES^XPDUTL("Filing CY 2012 Pension Threshold rates.")
  1. S IBX=3101201
  1. F S IBX=$O(^IBE(354.3,"B",IBX)) Q:'IBX D ; remove any records since 12/01/2010
  1. . S IBRN=0
  1. . F S IBRN=$O(^IBE(354.3,"B",IBX,IBRN)) Q:'IBRN D
  1. .. S DIK="^IBE(354.3,",DA=IBRN D ^DIK
  1. S IBA(354.3,"+1,",.01)=3111201 ; effective date for CY 2011 values
  1. S IBA(354.3,"+1,",.02)=1 ; internal value 1 = BASIC PENSION
  1. S IBA(354.3,"+1,",.03)=12256 ; base rate for veteran
  1. S IBA(354.3,"+1,",.04)=16051 ; 1 dependent
  1. S IBA(354.3,"+1,",.05)=18144 ; 2 dependents
  1. S IBA(354.3,"+1,",.06)=20237 ; 3 dependents
  1. S IBA(354.3,"+1,",.07)=22330 ; 4 dependents
  1. S IBA(354.3,"+1,",.08)=24423 ; 5 dependents
  1. S IBA(354.3,"+1,",.09)=26516 ; 6 dependents
  1. S IBA(354.3,"+1,",.10)=28609 ; 7 dependents
  1. S IBA(354.3,"+1,",.11)=30702 ; 8 dependents
  1. S IBA(354.3,"+1,",.12)=2093 ; additional dependent amount
  1. D UPDATE^DIE("","IBA","","IBERRM") ; file the new record for CY 2012
  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. MCRDED ; Medicare deductible rate for CY 2012
  1. ; check to see if rate already entered.
  1. N IBA,IBERRM,IBIEN,IBRN,IBTYPE,DA,DIK
  1. S IBTYPE="Medicare Deductible"
  1. D BMES^XPDUTL("Filing Medicare Deductible Rate for 01/01/2012")
  1. S IBIEN=0
  1. F S IBIEN=$O(^IBE(350.2,"B","MEDICARE DEDUCTIBLE",IBIEN)) Q:'IBIEN D
  1. . Q:$P($G(^IBE(350.2,IBIEN,0)),"^",2)'>3110101
  1. . S DIK="^IBE(350.2,",DA=IBIEN D ^DIK
  1. S IBA(350.2,"+1,",.01)="MEDICARE DEDUCTIBLE"
  1. S IBA(350.2,"+1,",.02)=3120101
  1. S IBA(350.2,"+1,",.03)=$O(^IBE(350.1,"B","MEDICARE DEDUCTIBLE",""))
  1. S IBA(350.2,"+1,",.04)=1156
  1. D UPDATE^DIE("","IBA","","IBERRM") ; file the new record
  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. MCRX Q
  1. ;
  1. PRIOR ;This code sets up the variables and calls the routine to print or print-and-update the
  1. ;exemption status. XPDQUES variables set in the pre-install are used.
  1. ;
  1. Q:'$D(^IBA(354.1,"APRIOR",3101201)) ; quit if the "APRIOR" x-ref is not set for 12/1/10.
  1. N %,IBACT,IBBMES,IBPR,IBPRDT,X,ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSK
  1. S IBACT=$G(XPDQUES("POS1")),IBACT=$S(IBACT="U":3,1:2)
  1. S ZTIO=$G(XPDQUES("POS2"))
  1. D NOW^%DTC S ZTDTH=%
  1. ;
  1. ; -- check to see if prior year thresholds used
  1. ;
  1. S IBPR=$P($G(^IBE(354.3,0)),"^",3) I IBPR="" Q
  1. S IBPR=$P(^IBE(354.3,IBPR,0),"^")
  1. S X=$S($E($P(IBPR,"^"),1,3)>296:1,1:2) S IBPRDT=$O(^IBE(354.3,"AIVDT",X,-($P(IBPR,"^")))) ;threshold prior to the one entered
  1. I IBPRDT<0 S IBPRDT=-IBPRDT ; invert negative number
  1. ; Queuing job.
  1. S IBBMES=$S(IBACT=3:"& UPDATE ",1:"") D BMES^XPDUTL(" >>>Queuing the PRINT "_IBBMES_"job to run NOW")
  1. S IO("Q")="",ZTRTN="DQ^IBARXET",ZTDESC="IB PRIOR YEAR THRESHOLD PRINT"_$S(IBACT=3:" AND UPDATE",1:""),ZTSAVE("IB*")="" D ^%ZTLOAD K IO("Q")
  1. S IBBMES=$S($D(ZTSK):"This job has been queued for NOW, as task number "_ZTSK_".",1:"This job could not be queued. Please edit the 12/1/11 threshold through the 'Add Income Thresholds' option, which allows you to queue this job.")
  1. D BMES^XPDUTL(" >>>"_IBBMES)
  1. PRIORQ Q ; end of prior exemptions section
  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*465 CY 2012 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*465. 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 2012 "_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*465 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. ;