IBY155PO ;ALB/DSM - IB*2*155 POST INIT ROUTINE ;25-MAR-2003
;;2.0;INTEGRATED BILLING;**155**; 21-MAR-94
;
POST ; Set up check points for post-init
S %=$$NEWCP^XPDUTL("ADDUSR","ADDUSR^IBY155PO")
;
; default a No in the automatic MRA process parameter if undefined
I $P($G(^IBE(350.9,1,8)),U,11)="" D
. NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
. S DIE=350.9,DA=1,DR="8.11////0" D ^DIE
. Q
;
; default a Yes in the allow MRA processing parameter if undefined
I $P($G(^IBE(350.9,1,8)),U,12)="" D
. NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
. S DIE=350.9,DA=1,DR="8.12////1" D ^DIE
. Q
;
; Add new Claims Tracking non-billable reasons (File 356.8)
D
. NEW DA,DIC,DO,X,Y
. F X="MRA REC'D. NO SEC RESP EXISTS","MRA REC'D. SEC NOT BILLED" D
.. I $D(^IBE(356.8,"B",X)) Q ; already on file
.. S DIC="^IBE(356.8,",DIC(0)="F"
.. D FILE^DICN
.. Q
. Q
;
; Add a new Bill Form Type for MRA reports
D BFT^IBY155PR
;
; Modify the Medicare entries in the IB PROVIDER ID # TYPE file (355.97)
D
. NEW P,NAME,CODE,DA,DIE,DR
. F P="A","B" D
.. S NAME="MEDICARE PART "_P
.. I P="A" S CODE=670899
.. I P="B" S CODE="VA0"_+$$SITE^VASITE()
.. S DA=$O(^IBE(355.97,"B",NAME,"")) Q:'DA
.. S DIE=355.97,DR=".03///1C;.04///"_CODE
.. D ^DIE
.. Q
. Q
;
; Update Short Description field for IEN #964 in File 364.6
N IBDESC,DA,DIE,DR
D BMES^XPDUTL("Updating Short Description field for IEN #964 in the IB FORM SKELETON DEFINITION FILE")
S IBDESC="COB COVERED DAYS"
S DA=964,DIE="^IBA(364.6,",DR=".1///^S X=IBDESC" D ^DIE
D COMPLETE
;
; Delete 3 action protocols from the CSA screen menu protocol
D BMES^XPDUTL("Removing actions from the CSA screen")
D CSA
D COMPLETE
;
; Build the new "AMRA" index for file 361.1
D BMES^XPDUTL("A new index will now be created for file 361.1.")
D AMRA,COMPLETE
;
; Delete old remark codes fields
D BMES^XPDUTL("Deleting old line item remarks code fields from EOB file 361.1")
S DIK="^DD(361.115,",DA(1)=361.115,DA=3.01 D ^DIK
S DIK="^DD(361.115,",DA(1)=361.115,DA=3.02 D ^DIK
D COMPLETE
;
; Check the insurance company file for fake Medicare WNR entries
D BMES^XPDUTL("Scanning Insurance Company File for Medicare WNR Entries ...")
D INSCHK^IBCEMU3,COMPLETE
;
;
Q ; IBY155PO
;
;
;
;
ADDUSR ; Add the Bill Authorizer for acceptable MRA secondary claims
; to the New Person file (#200)
;
N DIC,X,Y,DO,DD,DLAYGO
S DIC(0)="",DIC="^VA(200,",X="AUTHORIZER,IB MRA" D ^DIC
I Y>0 D Q
. D BMES^XPDUTL("User, AUTHORIZER,IB MRA, already exists in the NEW PERSON file - not added")
. D COMPLETE
D BMES^XPDUTL("Adding new user, AUTHORIZER,IB MRA, to the NEW PERSON file")
S DLAYGO=200,DIC(0)="L",DIC="^VA(200,",DIC("DR")="1////MRA",X="AUTHORIZER,IB MRA" D FILE^DICN K DIC,DO,DD,DLAYGO
I Y'>0 D
. D BMES^XPDUTL("A problem was encountered trying to add user, AUTHORIZER,IB MRA")
. D BMES^XPDUTL("The entry must be added manually to the NEW PERSON file")
E D
.D BMES^XPDUTL("User, AUTHORIZER,IB MRA, was successfully added to the NEW PERSON file")
D COMPLETE
Q
;
INCLUDE(Y) ; Code executed by build to determine which entries from file 364.7 should be included
NEW IBOUT,LINE S IBOUT=0
F LINE=2:1:5 I $P($T(ENT7+LINE),";;",2)[(U_+Y_U) S IBOUT=1 Q
INCX ;
Q IBOUT
;
ENT7 ; changed and new entries for file 364.7 to be included in build
;
;;^115^176^181^182^188^268^270^275^293^296^297^305^306^308^309^310^322^344^346^353^493^503^504^
;;^623^630^631^633^635^717^728^729^736^809^814^815^816^822^823^824^832^839^842^846^851^
;;^852^853^854^855^856^857^858^859^860^861^862^864^865^870^871^872^875^876^882^883^886^890^947^951^956^957^
;;^958^959^960^961^962^963^964^965^966^967^975^978^980^982^983^985^1013^1014^
Q
ENT6 ; new entry for file 364.6
;;^716^964^
Q
;
CSA ; Remove 3 actions from the CSA screen menu protocol
NEW AP,MPI,DA,DIK,API,APNM
S AP("IBCEM CSA EDIT BILL")=""
S AP("IBCEM CSA COB MANAGEMENT")=""
S AP("IBCEM CSA VIEW EOB")=""
S MPI=$O(^ORD(101,"B","IBCEM CSA MSG MENU","")) ; menu protocol ien
I 'MPI G CSAX
S DA(1)=MPI
S DIK="^ORD(101,"_MPI_",10,"
S DA=0 F S DA=$O(^ORD(101,MPI,10,DA)) Q:'DA D
. S API=+$G(^ORD(101,MPI,10,DA,0))
. S APNM=$P($G(^ORD(101,API,0)),U,1)
. I APNM="" Q
. I '$D(AP(APNM)) Q
. D ^DIK
. Q
CSAX ;
Q
;
AMRA ; Build the new index
N MRAXR,MRARES,MRAOUT
S MRAXR("FILE")=361.1
S MRAXR("NAME")="AMRA"
S MRAXR("TYPE")="R"
S MRAXR("USE")="S"
S MRAXR("EXECUTION")="R"
S MRAXR("ACTIVITY")="IR"
S MRAXR("SHORT DESCR")="Index by EOB type and Review Status"
S MRAXR("VAL",1)=.04
S MRAXR("VAL",1,"SUBSCRIPT")=1
S MRAXR("VAL",1,"COLLATION")="F"
S MRAXR("VAL",2)=.16
S MRAXR("VAL",2,"SUBSCRIPT")=2
S MRAXR("VAL",2,"COLLATION")="F"
D CREIXN^DDMOD(.MRAXR,"SW",.MRARES,"MRAOUT")
I +$G(MRARES) D MES^XPDUTL("Index successfully created!") G AMRAX
;
; Index file failure. Not created for some reason
;
D MES^XPDUTL("A PROBLEM WAS ENCOUNTERED. INDEX FILE NOT CREATED!!!")
D MES^XPDUTL("SENDING MAILMAN MESSAGE...")
D MES^XPDUTL("PLACING THE MRA MANAGEMENT SCREEN OUT-OF-ORDER.")
NEW XMDUZ,XMSUBJ,XMBODY,MSG,XMTO,DA,DIE,DR
S XMDUZ=DUZ,XMSUBJ="IB*2*155 Error: AMRA index not built",XMBODY="MSG"
S MSG(1)="The new ""AMRA"" index for file 361.1 was not created at"
S MSG(2)=" "
S MSG(3)=" "_$$SITE^VASITE
S MSG(4)=" "
S MSG(5)="The MRA management worklist has been placed out of order."
;
; recipients of message
S XMTO(DUZ)=""
S XMTO("eric.gustafson@daou.com")=""
S XMTO("michael.f.pida@us.pwc.com")=""
S XMTO("Janet.Harris2@domain.ext")=""
S XMTO("Loretta.Gulley2@domain.ext")=""
S XMTO("G.PATCHES")=""
S XMTO("G.IB EDI")=""
S XMTO("G.IB EDI SUPERVISOR")=""
;
D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
;
; place MRA management worklist screen out of order
S DA=$O(^DIC(19,"B","IBCE MRA MANAGEMENT",""))
I DA S DIE=19,DR="2////IB Patch 155 Installation Failure" D ^DIE
;
AMRAX ;
Q
;
COMPLETE ;
D BMES^XPDUTL("Step complete.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY155PO 6089 printed Sep 23, 2025@20:09:48 Page 2
IBY155PO ;ALB/DSM - IB*2*155 POST INIT ROUTINE ;25-MAR-2003
+1 ;;2.0;INTEGRATED BILLING;**155**; 21-MAR-94
+2 ;
POST ; Set up check points for post-init
+1 SET %=$$NEWCP^XPDUTL("ADDUSR","ADDUSR^IBY155PO")
+2 ;
+3 ; default a No in the automatic MRA process parameter if undefined
+4 IF $PIECE($GET(^IBE(350.9,1,8)),U,11)=""
Begin DoDot:1
+5 NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
+6 SET DIE=350.9
SET DA=1
SET DR="8.11////0"
DO ^DIE
+7 QUIT
End DoDot:1
+8 ;
+9 ; default a Yes in the allow MRA processing parameter if undefined
+10 IF $PIECE($GET(^IBE(350.9,1,8)),U,12)=""
Begin DoDot:1
+11 NEW D,D0,DA,DI,DIC,DIE,DQ,DR,X,Y
+12 SET DIE=350.9
SET DA=1
SET DR="8.12////1"
DO ^DIE
+13 QUIT
End DoDot:1
+14 ;
+15 ; Add new Claims Tracking non-billable reasons (File 356.8)
+16 Begin DoDot:1
+17 NEW DA,DIC,DO,X,Y
+18 FOR X="MRA REC'D. NO SEC RESP EXISTS","MRA REC'D. SEC NOT BILLED"
Begin DoDot:2
+19 ; already on file
IF $DATA(^IBE(356.8,"B",X))
QUIT
+20 SET DIC="^IBE(356.8,"
SET DIC(0)="F"
+21 DO FILE^DICN
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 ;
+25 ; Add a new Bill Form Type for MRA reports
+26 DO BFT^IBY155PR
+27 ;
+28 ; Modify the Medicare entries in the IB PROVIDER ID # TYPE file (355.97)
+29 Begin DoDot:1
+30 NEW P,NAME,CODE,DA,DIE,DR
+31 FOR P="A","B"
Begin DoDot:2
+32 SET NAME="MEDICARE PART "_P
+33 IF P="A"
SET CODE=670899
+34 IF P="B"
SET CODE="VA0"_+$$SITE^VASITE()
+35 SET DA=$ORDER(^IBE(355.97,"B",NAME,""))
if 'DA
QUIT
+36 SET DIE=355.97
SET DR=".03///1C;.04///"_CODE
+37 DO ^DIE
+38 QUIT
End DoDot:2
+39 QUIT
End DoDot:1
+40 ;
+41 ; Update Short Description field for IEN #964 in File 364.6
+42 NEW IBDESC,DA,DIE,DR
+43 DO BMES^XPDUTL("Updating Short Description field for IEN #964 in the IB FORM SKELETON DEFINITION FILE")
+44 SET IBDESC="COB COVERED DAYS"
+45 SET DA=964
SET DIE="^IBA(364.6,"
SET DR=".1///^S X=IBDESC"
DO ^DIE
+46 DO COMPLETE
+47 ;
+48 ; Delete 3 action protocols from the CSA screen menu protocol
+49 DO BMES^XPDUTL("Removing actions from the CSA screen")
+50 DO CSA
+51 DO COMPLETE
+52 ;
+53 ; Build the new "AMRA" index for file 361.1
+54 DO BMES^XPDUTL("A new index will now be created for file 361.1.")
+55 DO AMRA
DO COMPLETE
+56 ;
+57 ; Delete old remark codes fields
+58 DO BMES^XPDUTL("Deleting old line item remarks code fields from EOB file 361.1")
+59 SET DIK="^DD(361.115,"
SET DA(1)=361.115
SET DA=3.01
DO ^DIK
+60 SET DIK="^DD(361.115,"
SET DA(1)=361.115
SET DA=3.02
DO ^DIK
+61 DO COMPLETE
+62 ;
+63 ; Check the insurance company file for fake Medicare WNR entries
+64 DO BMES^XPDUTL("Scanning Insurance Company File for Medicare WNR Entries ...")
+65 DO INSCHK^IBCEMU3
DO COMPLETE
+66 ;
+67 ;
+68 ; IBY155PO
QUIT
+69 ;
+70 ;
+71 ;
+72 ;
ADDUSR ; Add the Bill Authorizer for acceptable MRA secondary claims
+1 ; to the New Person file (#200)
+2 ;
+3 NEW DIC,X,Y,DO,DD,DLAYGO
+4 SET DIC(0)=""
SET DIC="^VA(200,"
SET X="AUTHORIZER,IB MRA"
DO ^DIC
+5 IF Y>0
Begin DoDot:1
+6 DO BMES^XPDUTL("User, AUTHORIZER,IB MRA, already exists in the NEW PERSON file - not added")
+7 DO COMPLETE
End DoDot:1
QUIT
+8 DO BMES^XPDUTL("Adding new user, AUTHORIZER,IB MRA, to the NEW PERSON file")
+9 SET DLAYGO=200
SET DIC(0)="L"
SET DIC="^VA(200,"
SET DIC("DR")="1////MRA"
SET X="AUTHORIZER,IB MRA"
DO FILE^DICN
KILL DIC,DO,DD,DLAYGO
+10 IF Y'>0
Begin DoDot:1
+11 DO BMES^XPDUTL("A problem was encountered trying to add user, AUTHORIZER,IB MRA")
+12 DO BMES^XPDUTL("The entry must be added manually to the NEW PERSON file")
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 DO BMES^XPDUTL("User, AUTHORIZER,IB MRA, was successfully added to the NEW PERSON file")
End DoDot:1
+15 DO COMPLETE
+16 QUIT
+17 ;
INCLUDE(Y) ; Code executed by build to determine which entries from file 364.7 should be included
+1 NEW IBOUT,LINE
SET IBOUT=0
+2 FOR LINE=2:1:5
IF $PIECE($TEXT(ENT7+LINE),";;",2)[(U_+Y_U)
SET IBOUT=1
QUIT
INCX ;
+1 QUIT IBOUT
+2 ;
ENT7 ; changed and new entries for file 364.7 to be included in build
+1 ;
+2 ;;^115^176^181^182^188^268^270^275^293^296^297^305^306^308^309^310^322^344^346^353^493^503^504^
+3 ;;^623^630^631^633^635^717^728^729^736^809^814^815^816^822^823^824^832^839^842^846^851^
+4 ;;^852^853^854^855^856^857^858^859^860^861^862^864^865^870^871^872^875^876^882^883^886^890^947^951^956^957^
+5 ;;^958^959^960^961^962^963^964^965^966^967^975^978^980^982^983^985^1013^1014^
+6 QUIT
ENT6 ; new entry for file 364.6
+1 ;;^716^964^
+2 QUIT
+3 ;
CSA ; Remove 3 actions from the CSA screen menu protocol
+1 NEW AP,MPI,DA,DIK,API,APNM
+2 SET AP("IBCEM CSA EDIT BILL")=""
+3 SET AP("IBCEM CSA COB MANAGEMENT")=""
+4 SET AP("IBCEM CSA VIEW EOB")=""
+5 ; menu protocol ien
SET MPI=$ORDER(^ORD(101,"B","IBCEM CSA MSG MENU",""))
+6 IF 'MPI
GOTO CSAX
+7 SET DA(1)=MPI
+8 SET DIK="^ORD(101,"_MPI_",10,"
+9 SET DA=0
FOR
SET DA=$ORDER(^ORD(101,MPI,10,DA))
if 'DA
QUIT
Begin DoDot:1
+10 SET API=+$GET(^ORD(101,MPI,10,DA,0))
+11 SET APNM=$PIECE($GET(^ORD(101,API,0)),U,1)
+12 IF APNM=""
QUIT
+13 IF '$DATA(AP(APNM))
QUIT
+14 DO ^DIK
+15 QUIT
End DoDot:1
CSAX ;
+1 QUIT
+2 ;
AMRA ; Build the new index
+1 NEW MRAXR,MRARES,MRAOUT
+2 SET MRAXR("FILE")=361.1
+3 SET MRAXR("NAME")="AMRA"
+4 SET MRAXR("TYPE")="R"
+5 SET MRAXR("USE")="S"
+6 SET MRAXR("EXECUTION")="R"
+7 SET MRAXR("ACTIVITY")="IR"
+8 SET MRAXR("SHORT DESCR")="Index by EOB type and Review Status"
+9 SET MRAXR("VAL",1)=.04
+10 SET MRAXR("VAL",1,"SUBSCRIPT")=1
+11 SET MRAXR("VAL",1,"COLLATION")="F"
+12 SET MRAXR("VAL",2)=.16
+13 SET MRAXR("VAL",2,"SUBSCRIPT")=2
+14 SET MRAXR("VAL",2,"COLLATION")="F"
+15 DO CREIXN^DDMOD(.MRAXR,"SW",.MRARES,"MRAOUT")
+16 IF +$GET(MRARES)
DO MES^XPDUTL("Index successfully created!")
GOTO AMRAX
+17 ;
+18 ; Index file failure. Not created for some reason
+19 ;
+20 DO MES^XPDUTL("A PROBLEM WAS ENCOUNTERED. INDEX FILE NOT CREATED!!!")
+21 DO MES^XPDUTL("SENDING MAILMAN MESSAGE...")
+22 DO MES^XPDUTL("PLACING THE MRA MANAGEMENT SCREEN OUT-OF-ORDER.")
+23 NEW XMDUZ,XMSUBJ,XMBODY,MSG,XMTO,DA,DIE,DR
+24 SET XMDUZ=DUZ
SET XMSUBJ="IB*2*155 Error: AMRA index not built"
SET XMBODY="MSG"
+25 SET MSG(1)="The new ""AMRA"" index for file 361.1 was not created at"
+26 SET MSG(2)=" "
+27 SET MSG(3)=" "_$$SITE^VASITE
+28 SET MSG(4)=" "
+29 SET MSG(5)="The MRA management worklist has been placed out of order."
+30 ;
+31 ; recipients of message
+32 SET XMTO(DUZ)=""
+33 SET XMTO("eric.gustafson@daou.com")=""
+34 SET XMTO("michael.f.pida@us.pwc.com")=""
+35 SET XMTO("Janet.Harris2@domain.ext")=""
+36 SET XMTO("Loretta.Gulley2@domain.ext")=""
+37 SET XMTO("G.PATCHES")=""
+38 SET XMTO("G.IB EDI")=""
+39 SET XMTO("G.IB EDI SUPERVISOR")=""
+40 ;
+41 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO)
+42 ;
+43 ; place MRA management worklist screen out of order
+44 SET DA=$ORDER(^DIC(19,"B","IBCE MRA MANAGEMENT",""))
+45 IF DA
SET DIE=19
SET DR="2////IB Patch 155 Installation Failure"
DO ^DIE
+46 ;
AMRAX ;
+1 QUIT
+2 ;
COMPLETE ;
+1 DO BMES^XPDUTL("Step complete.")
+2 QUIT
+3 ;
