- IB20P465 ;ALB/TDM - POST-INIT FOR IB*2.0*465 ; 11/17/11 10:57am
- ;;2.0;INTEGRATED BILLING;**465**;21-MAR-94;Build 5
- ;
- PRE ; set up check points for pre/post-init
- N %
- S %=$$NEWCP^XPDUTL("THRESH","THRESH^IB20P465")
- S %=$$NEWCP^XPDUTL("MCRDED","MCRDED^IB20P465")
- S %=$$NEWCP^XPDUTL("PRIOR","PRIOR^IB20P465")
- Q
- ;
- THRESH ; Pension Threshold
- N IBA,IBERRM,IBRN,IBTYPE,IBX,DA,DIK
- S IBTYPE="Pension Threshold"
- D BMES^XPDUTL("Filing CY 2012 Pension Threshold rates.")
- S IBX=3101201
- F S IBX=$O(^IBE(354.3,"B",IBX)) Q:'IBX D ; remove any records since 12/01/2010
- . S IBRN=0
- . F S IBRN=$O(^IBE(354.3,"B",IBX,IBRN)) Q:'IBRN D
- .. S DIK="^IBE(354.3,",DA=IBRN D ^DIK
- S IBA(354.3,"+1,",.01)=3111201 ; effective date for CY 2011 values
- S IBA(354.3,"+1,",.02)=1 ; internal value 1 = BASIC PENSION
- S IBA(354.3,"+1,",.03)=12256 ; base rate for veteran
- S IBA(354.3,"+1,",.04)=16051 ; 1 dependent
- S IBA(354.3,"+1,",.05)=18144 ; 2 dependents
- S IBA(354.3,"+1,",.06)=20237 ; 3 dependents
- S IBA(354.3,"+1,",.07)=22330 ; 4 dependents
- S IBA(354.3,"+1,",.08)=24423 ; 5 dependents
- S IBA(354.3,"+1,",.09)=26516 ; 6 dependents
- S IBA(354.3,"+1,",.10)=28609 ; 7 dependents
- S IBA(354.3,"+1,",.11)=30702 ; 8 dependents
- S IBA(354.3,"+1,",.12)=2093 ; additional dependent amount
- D UPDATE^DIE("","IBA","","IBERRM") ; file the new record for CY 2012
- I $D(IBERRM) D
- . D BMES^XPDUTL("Unable to file the new rates. The error message is as follows:")
- . S IBRN=0
- . F S IBRN=$O(IBERRM("DIERR",1,"TEXT",IBRN)) Q:IBRN="" D MES^XPDUTL(IBERRM("DIERR",1,"TEXT",IBRN))
- . D BMES^XPDUTL("Please check the database and then file the new rates manually.")
- . D MMSG
- E D COMPLETE
- Q
- ;
- MCRDED ; Medicare deductible rate for CY 2012
- ; check to see if rate already entered.
- N IBA,IBERRM,IBIEN,IBRN,IBTYPE,DA,DIK
- S IBTYPE="Medicare Deductible"
- D BMES^XPDUTL("Filing Medicare Deductible Rate for 01/01/2012")
- S IBIEN=0
- F S IBIEN=$O(^IBE(350.2,"B","MEDICARE DEDUCTIBLE",IBIEN)) Q:'IBIEN D
- . Q:$P($G(^IBE(350.2,IBIEN,0)),"^",2)'>3110101
- . S DIK="^IBE(350.2,",DA=IBIEN D ^DIK
- S IBA(350.2,"+1,",.01)="MEDICARE DEDUCTIBLE"
- S IBA(350.2,"+1,",.02)=3120101
- S IBA(350.2,"+1,",.03)=$O(^IBE(350.1,"B","MEDICARE DEDUCTIBLE",""))
- S IBA(350.2,"+1,",.04)=1156
- D UPDATE^DIE("","IBA","","IBERRM") ; file the new record
- I $D(IBERRM) D
- . D BMES^XPDUTL("Unable to file the new rates. The error message is as follows:")
- . S IBRN=0
- . F S IBRN=$O(IBERRM("DIERR",1,"TEXT",IBRN)) Q:IBRN="" D MES^XPDUTL(IBERRM("DIERR",1,"TEXT",IBRN))
- . D BMES^XPDUTL("Please check the database and then file the new rates manually.")
- . D MMSG
- E D COMPLETE
- MCRX Q
- ;
- PRIOR ;This code sets up the variables and calls the routine to print or print-and-update the
- ;exemption status. XPDQUES variables set in the pre-install are used.
- ;
- Q:'$D(^IBA(354.1,"APRIOR",3101201)) ; quit if the "APRIOR" x-ref is not set for 12/1/10.
- N %,IBACT,IBBMES,IBPR,IBPRDT,X,ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSK
- S IBACT=$G(XPDQUES("POS1")),IBACT=$S(IBACT="U":3,1:2)
- S ZTIO=$G(XPDQUES("POS2"))
- D NOW^%DTC S ZTDTH=%
- ;
- ; -- check to see if prior year thresholds used
- ;
- S IBPR=$P($G(^IBE(354.3,0)),"^",3) I IBPR="" Q
- S IBPR=$P(^IBE(354.3,IBPR,0),"^")
- 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
- I IBPRDT<0 S IBPRDT=-IBPRDT ; invert negative number
- ; Queuing job.
- S IBBMES=$S(IBACT=3:"& UPDATE ",1:"") D BMES^XPDUTL(" >>>Queuing the PRINT "_IBBMES_"job to run NOW")
- 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")
- 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.")
- D BMES^XPDUTL(" >>>"_IBBMES)
- PRIORQ Q ; end of prior exemptions section
- ;
- MMSG ; MailMan message to report update problem to billing groups, patch installer and patch developer
- N DA,IBC,IBGROUP,IBPARAM,IBTXT,XMDUZ,XMSUB,XMTEXT,XMY
- S XMSUB="Integrated Billing Annual Rate Update Error"
- S XMDUZ=DUZ,XMTEXT="IBTXT"
- S IBPARAM("FROM")="PATCH IB*2.0*465 CY 2012 RATE UPDATE"
- F IBGROUP="IB EDI SUPERVISOR","IB ERROR","MCCR" D
- . I $D(^XMB(3.8,"B",IBGROUP)) S IBGROUP="G."_IBGROUP,XMY(IBGROUP)=""
- S XMY(DUZ)=""
- ;
- S IBC=0
- S IBC=IBC+1,IBTXT(IBC)="This message has been sent by patch IB*2.0*465. If you have received this"
- S IBC=IBC+1,IBTXT(IBC)="message, it indicates that the patch encountered some difficulty in filing"
- S IBC=IBC+1,IBTXT(IBC)="the CY 2012 "_IBTYPE_" rates as outlined in the patch description."
- S IBC=IBC+1,IBTXT(IBC)="Please verify the integrity of files 354.3 - BILLING THRESHOLDS and"
- S IBC=IBC+1,IBTXT(IBC)="350.2 - IB ACTION CHARGE and then enter the new rates manually."
- S IBC=IBC+1,IBTXT(IBC)="You can consult the IB*2.0*465 patch description for additional information."
- S IBC=IBC+1,IBTXT(IBC)=" "
- S IBC=IBC+1,IBTXT(IBC)="This action only needs to be done by one person. Please verify with the"
- S IBC=IBC+1,IBTXT(IBC)="appropriate billing supervisor that the update has been accomplished."
- D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.IBPARAM,"","")
- MMSGQ Q ; end of Mail Message subroutine
- ;
- COMPLETE ; display message that step has completed successfully
- D BMES^XPDUTL("Step complete.")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P465 5520 printed Jan 18, 2025@03:04:17 Page 2
- 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
- +2 ;
- PRE ; set up check points for pre/post-init
- +1 NEW %
- +2 SET %=$$NEWCP^XPDUTL("THRESH","THRESH^IB20P465")
- +3 SET %=$$NEWCP^XPDUTL("MCRDED","MCRDED^IB20P465")
- +4 SET %=$$NEWCP^XPDUTL("PRIOR","PRIOR^IB20P465")
- +5 QUIT
- +6 ;
- THRESH ; Pension Threshold
- +1 NEW IBA,IBERRM,IBRN,IBTYPE,IBX,DA,DIK
- +2 SET IBTYPE="Pension Threshold"
- +3 DO BMES^XPDUTL("Filing CY 2012 Pension Threshold rates.")
- +4 SET IBX=3101201
- +5 ; remove any records since 12/01/2010
- FOR
- SET IBX=$ORDER(^IBE(354.3,"B",IBX))
- if 'IBX
- QUIT
- Begin DoDot:1
- +6 SET IBRN=0
- +7 FOR
- SET IBRN=$ORDER(^IBE(354.3,"B",IBX,IBRN))
- if 'IBRN
- QUIT
- Begin DoDot:2
- +8 SET DIK="^IBE(354.3,"
- SET DA=IBRN
- DO ^DIK
- End DoDot:2
- End DoDot:1
- +9 ; effective date for CY 2011 values
- SET IBA(354.3,"+1,",.01)=3111201
- +10 ; internal value 1 = BASIC PENSION
- SET IBA(354.3,"+1,",.02)=1
- +11 ; base rate for veteran
- SET IBA(354.3,"+1,",.03)=12256
- +12 ; 1 dependent
- SET IBA(354.3,"+1,",.04)=16051
- +13 ; 2 dependents
- SET IBA(354.3,"+1,",.05)=18144
- +14 ; 3 dependents
- SET IBA(354.3,"+1,",.06)=20237
- +15 ; 4 dependents
- SET IBA(354.3,"+1,",.07)=22330
- +16 ; 5 dependents
- SET IBA(354.3,"+1,",.08)=24423
- +17 ; 6 dependents
- SET IBA(354.3,"+1,",.09)=26516
- +18 ; 7 dependents
- SET IBA(354.3,"+1,",.10)=28609
- +19 ; 8 dependents
- SET IBA(354.3,"+1,",.11)=30702
- +20 ; additional dependent amount
- SET IBA(354.3,"+1,",.12)=2093
- +21 ; file the new record for CY 2012
- DO UPDATE^DIE("","IBA","","IBERRM")
- +22 IF $DATA(IBERRM)
- Begin DoDot:1
- +23 DO BMES^XPDUTL("Unable to file the new rates. The error message is as follows:")
- +24 SET IBRN=0
- +25 FOR
- SET IBRN=$ORDER(IBERRM("DIERR",1,"TEXT",IBRN))
- if IBRN=""
- QUIT
- DO MES^XPDUTL(IBERRM("DIERR",1,"TEXT",IBRN))
- +26 DO BMES^XPDUTL("Please check the database and then file the new rates manually.")
- +27 DO MMSG
- End DoDot:1
- +28 IF '$TEST
- DO COMPLETE
- +29 QUIT
- +30 ;
- MCRDED ; Medicare deductible rate for CY 2012
- +1 ; check to see if rate already entered.
- +2 NEW IBA,IBERRM,IBIEN,IBRN,IBTYPE,DA,DIK
- +3 SET IBTYPE="Medicare Deductible"
- +4 DO BMES^XPDUTL("Filing Medicare Deductible Rate for 01/01/2012")
- +5 SET IBIEN=0
- +6 FOR
- SET IBIEN=$ORDER(^IBE(350.2,"B","MEDICARE DEDUCTIBLE",IBIEN))
- if 'IBIEN
- QUIT
- Begin DoDot:1
- +7 if $PIECE($GET(^IBE(350.2,IBIEN,0)),"^",2)'>3110101
- QUIT
- +8 SET DIK="^IBE(350.2,"
- SET DA=IBIEN
- DO ^DIK
- End DoDot:1
- +9 SET IBA(350.2,"+1,",.01)="MEDICARE DEDUCTIBLE"
- +10 SET IBA(350.2,"+1,",.02)=3120101
- +11 SET IBA(350.2,"+1,",.03)=$ORDER(^IBE(350.1,"B","MEDICARE DEDUCTIBLE",""))
- +12 SET IBA(350.2,"+1,",.04)=1156
- +13 ; file the new record
- DO UPDATE^DIE("","IBA","","IBERRM")
- +14 IF $DATA(IBERRM)
- Begin DoDot:1
- +15 DO BMES^XPDUTL("Unable to file the new rates. The error message is as follows:")
- +16 SET IBRN=0
- +17 FOR
- SET IBRN=$ORDER(IBERRM("DIERR",1,"TEXT",IBRN))
- if IBRN=""
- QUIT
- DO MES^XPDUTL(IBERRM("DIERR",1,"TEXT",IBRN))
- +18 DO BMES^XPDUTL("Please check the database and then file the new rates manually.")
- +19 DO MMSG
- End DoDot:1
- +20 IF '$TEST
- DO COMPLETE
- MCRX QUIT
- +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.
- +2 ;
- +3 ; quit if the "APRIOR" x-ref is not set for 12/1/10.
- if '$DATA(^IBA(354.1,"APRIOR",3101201))
- QUIT
- +4 NEW %,IBACT,IBBMES,IBPR,IBPRDT,X,ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSK
- +5 SET IBACT=$GET(XPDQUES("POS1"))
- SET IBACT=$SELECT(IBACT="U":3,1:2)
- +6 SET ZTIO=$GET(XPDQUES("POS2"))
- +7 DO NOW^%DTC
- SET ZTDTH=%
- +8 ;
- +9 ; -- check to see if prior year thresholds used
- +10 ;
- +11 SET IBPR=$PIECE($GET(^IBE(354.3,0)),"^",3)
- IF IBPR=""
- QUIT
- +12 SET IBPR=$PIECE(^IBE(354.3,IBPR,0),"^")
- +13 ;threshold prior to the one entered
- SET X=$SELECT($EXTRACT($PIECE(IBPR,"^"),1,3)>296:1,1:2)
- SET IBPRDT=$ORDER(^IBE(354.3,"AIVDT",X,-($PIECE(IBPR,"^"))))
- +14 ; invert negative number
- IF IBPRDT<0
- SET IBPRDT=-IBPRDT
- +15 ; Queuing job.
- +16 SET IBBMES=$SELECT(IBACT=3:"& UPDATE ",1:"")
- DO BMES^XPDUTL(" >>>Queuing the PRINT "_IBBMES_"job to run NOW")
- +17 SET IO("Q")=""
- SET ZTRTN="DQ^IBARXET"
- SET ZTDESC="IB PRIOR YEAR THRESHOLD PRINT"_$SELECT(IBACT=3:" AND UPDATE",1:"")
- SET ZTSAVE("IB*")=""
- DO ^%ZTLOAD
- KILL IO("Q")
- +18 SET IBBMES=$SELECT($DATA(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.")
- +19 DO BMES^XPDUTL(" >>>"_IBBMES)
- PRIORQ ; end of prior exemptions section
- QUIT
- +1 ;
- MMSG ; MailMan message to report update problem to billing groups, patch installer and patch developer
- +1 NEW DA,IBC,IBGROUP,IBPARAM,IBTXT,XMDUZ,XMSUB,XMTEXT,XMY
- +2 SET XMSUB="Integrated Billing Annual Rate Update Error"
- +3 SET XMDUZ=DUZ
- SET XMTEXT="IBTXT"
- +4 SET IBPARAM("FROM")="PATCH IB*2.0*465 CY 2012 RATE UPDATE"
- +5 FOR IBGROUP="IB EDI SUPERVISOR","IB ERROR","MCCR"
- Begin DoDot:1
- +6 IF $DATA(^XMB(3.8,"B",IBGROUP))
- SET IBGROUP="G."_IBGROUP
- SET XMY(IBGROUP)=""
- End DoDot:1
- +7 SET XMY(DUZ)=""
- +8 ;
- +9 SET IBC=0
- +10 SET IBC=IBC+1
- SET IBTXT(IBC)="This message has been sent by patch IB*2.0*465. If you have received this"
- +11 SET IBC=IBC+1
- SET IBTXT(IBC)="message, it indicates that the patch encountered some difficulty in filing"
- +12 SET IBC=IBC+1
- SET IBTXT(IBC)="the CY 2012 "_IBTYPE_" rates as outlined in the patch description."
- +13 SET IBC=IBC+1
- SET IBTXT(IBC)="Please verify the integrity of files 354.3 - BILLING THRESHOLDS and"
- +14 SET IBC=IBC+1
- SET IBTXT(IBC)="350.2 - IB ACTION CHARGE and then enter the new rates manually."
- +15 SET IBC=IBC+1
- SET IBTXT(IBC)="You can consult the IB*2.0*465 patch description for additional information."
- +16 SET IBC=IBC+1
- SET IBTXT(IBC)=" "
- +17 SET IBC=IBC+1
- SET IBTXT(IBC)="This action only needs to be done by one person. Please verify with the"
- +18 SET IBC=IBC+1
- SET IBTXT(IBC)="appropriate billing supervisor that the update has been accomplished."
- +19 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.IBPARAM,"","")
- MMSGQ ; end of Mail Message subroutine
- QUIT
- +1 ;
- COMPLETE ; display message that step has completed successfully
- +1 DO BMES^XPDUTL("Step complete.")
- +2 QUIT
- +3 ;