Routine: IBY155PO

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)

 . 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)

 . 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

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^

ENT6 ; new entry for file 364.6

 ;;^716^964^

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 ;

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 ;

COMPLETE ;

 D BMES^XPDUTL("Step complete.")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY155PO   6089     printed  Feb 18, 2025@23:59:54                                                                                                                                                                                                    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       ;

IBY155PO.m