IB20428P ;ALB/LBD - POST-INIT FOR IB*2.0*428; 11/25/2008 ; 1/7/10 10:49am
;;2.0;INTEGRATED BILLING;**428**;21-MAR-94;Build 1
;
MCRDED ; Update Medicare Deductible rate for CY 2010
; check to see if rate already entered.
N IBA,IBERRM,IBIEN,IBRN,IBTYPE,DA,DIK
S IBTYPE="Medicare Deductible"
D BMES^XPDUTL("Updating Medicare Deductible Rate for 01/01/2010")
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)'>3090101
. S DIK="^IBE(350.2,",DA=IBIEN D ^DIK
S IBA(350.2,"+1,",.01)="MEDICARE DEDUCTIBLE"
S IBA(350.2,"+1,",.02)=3100101
S IBA(350.2,"+1,",.03)=$O(^IBE(350.1,"B","MEDICARE DEDUCTIBLE",""))
S IBA(350.2,"+1,",.04)=1100
D UPDATE^DIE("","IBA","","IBERRM") ; file the new record
I $D(IBERRM) D
. D BMES^XPDUTL("Unable to file the new rate. 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 rate manually.")
. D MMSG
E D COMPLETE
MCRX 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*428 CY 2010 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*428. 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 2010 "_IBTYPE_" rate as outlined in the patch description."
S IBC=IBC+1,IBTXT(IBC)="Please verify the integrity of file 350.2 IB ACTION CHARGE and then enter"
S IBC=IBC+1,IBTXT(IBC)="the new rate manually. You can consult the IB*2.0*428 patch description"
S IBC=IBC+1,IBTXT(IBC)="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("Update completed.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20428P 2577 printed Apr 09, 2024@21:28:28 Page 2
IB20428P ;ALB/LBD - POST-INIT FOR IB*2.0*428; 11/25/2008 ; 1/7/10 10:49am
+1 ;;2.0;INTEGRATED BILLING;**428**;21-MAR-94;Build 1
+2 ;
MCRDED ; Update Medicare Deductible rate for CY 2010
+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("Updating Medicare Deductible Rate for 01/01/2010")
+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)'>3090101
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)=3100101
+11 SET IBA(350.2,"+1,",.03)=$ORDER(^IBE(350.1,"B","MEDICARE DEDUCTIBLE",""))
+12 SET IBA(350.2,"+1,",.04)=1100
+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 rate. 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 rate manually.")
+19 DO MMSG
End DoDot:1
+20 IF '$TEST
DO COMPLETE
MCRX QUIT
+1 ;
+2 ;
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*428 CY 2010 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*428. 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 2010 "_IBTYPE_" rate as outlined in the patch description."
+13 SET IBC=IBC+1
SET IBTXT(IBC)="Please verify the integrity of file 350.2 IB ACTION CHARGE and then enter"
+14 SET IBC=IBC+1
SET IBTXT(IBC)="the new rate manually. You can consult the IB*2.0*428 patch description"
+15 SET IBC=IBC+1
SET IBTXT(IBC)="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("Update completed.")
+2 QUIT
+3 ;
