- IB20P620 ;MNT/BJR - POST-INIT FOR IB*2.0*620 ;Mar 8,2018@8:29am
- ;;2.0;INTEGRATED BILLING;**620**;21-MAR-94;Build 1
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- THRESH ; Pension Threshold
- N IBA,IBERRM,IBRN,IBTYPE,IBX,DA,DIK,IBADLDEP
- S IBTYPE="Pension Threshold"
- D BMES^XPDUTL("Filing CY 2017 Pension Threshold rates.")
- I $D(^IBE(354.3,"B",3161201)) D ; remove 12/01/2016 if exists befre filing
- . S IBRN=0
- . F S IBRN=$O(^IBE(354.3,"B",3161201,IBRN)) Q:'IBRN D
- .. S DIK="^IBE(354.3,",DA=IBRN D ^DIK
- S IBA(354.3,"+1,",.01)=3161201 ; effective date for CY 2017 values
- S IBA(354.3,"+1,",.02)=1 ; internal value 1 = BASIC PENSION
- S IBA(354.3,"+1,",.03)=12907 ; base rate for veteran
- S IBA(354.3,"+1,",.04)=16902 ; 1 dependent
- S IBADLDEP=2205 ; additional dependent amount
- F IBX=.05:.01:.11 S IBA(354.3,"+1,",IBX)=IBA(354.3,"+1,",IBX-.01)+IBADLDEP ;2 thru 8 dependents
- S IBA(354.3,"+1,",.12)=IBADLDEP ; additional dependent amount
- D UPDATE^DIE("","IBA","","IBERRM") ; file the new record for CY 2017
- 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
- ;
- 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*620 CY 2017 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*620. 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 2017 "_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*620 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[HIB20P620 2886 printed Feb 18, 2025@23:30:31 Page 2
- 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
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- THRESH ; Pension Threshold
- +1 NEW IBA,IBERRM,IBRN,IBTYPE,IBX,DA,DIK,IBADLDEP
- +2 SET IBTYPE="Pension Threshold"
- +3 DO BMES^XPDUTL("Filing CY 2017 Pension Threshold rates.")
- +4 ; remove 12/01/2016 if exists befre filing
- IF $DATA(^IBE(354.3,"B",3161201))
- Begin DoDot:1
- +5 SET IBRN=0
- +6 FOR
- SET IBRN=$ORDER(^IBE(354.3,"B",3161201,IBRN))
- if 'IBRN
- QUIT
- Begin DoDot:2
- +7 SET DIK="^IBE(354.3,"
- SET DA=IBRN
- DO ^DIK
- End DoDot:2
- End DoDot:1
- +8 ; effective date for CY 2017 values
- SET IBA(354.3,"+1,",.01)=3161201
- +9 ; internal value 1 = BASIC PENSION
- SET IBA(354.3,"+1,",.02)=1
- +10 ; base rate for veteran
- SET IBA(354.3,"+1,",.03)=12907
- +11 ; 1 dependent
- SET IBA(354.3,"+1,",.04)=16902
- +12 ; additional dependent amount
- SET IBADLDEP=2205
- +13 ;2 thru 8 dependents
- FOR IBX=.05:.01:.11
- SET IBA(354.3,"+1,",IBX)=IBA(354.3,"+1,",IBX-.01)+IBADLDEP
- +14 ; additional dependent amount
- SET IBA(354.3,"+1,",.12)=IBADLDEP
- +15 ; file the new record for CY 2017
- DO UPDATE^DIE("","IBA","","IBERRM")
- +16 IF $DATA(IBERRM)
- Begin DoDot:1
- +17 DO BMES^XPDUTL("Unable to file the new rates. The error message is as follows:")
- +18 SET IBRN=0
- +19 FOR
- SET IBRN=$ORDER(IBERRM("DIERR",1,"TEXT",IBRN))
- if IBRN=""
- QUIT
- DO MES^XPDUTL(IBERRM("DIERR",1,"TEXT",IBRN))
- +20 DO BMES^XPDUTL("Please check the database and then file the new rates manually.")
- +21 DO MMSG
- End DoDot:1
- +22 IF '$TEST
- DO COMPLETE
- +23 QUIT
- +24 ;
- 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*620 CY 2017 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*620. 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 2017 "_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*620 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 ;