ABMP263.m

ABMP263 ; IHS/SD/SDR - 3P BILLING 2.6 Patch 3 PRE/POST INIT ;  

 ;;2.6;IHS Third Party Billing System;**3**;NOV 12, 2009

 ;

PRE ;

 Q

POST ;

 D TURNON^DIAUTL(9002274.5,.09,"y")  ;audit 3P Parameters, current default fee sched

 D TURNON^DIAUTL(9002274.091,.05,"y")  ;audit 3P Insurer file, visit type mult, fee sched

 D ERRCD  ;error codes for claim editor

 D REINDEX  ;run new cross reference for 3P Bill file, Re-export multiple

 Q

ERRCD ;

 ;234 - tribal self-insured

 K DIC,X

 S DIC="^ABMDERR("

 S DIC(0)="LM"

 S DINUM=234

 S X="INSURER DESIGNED AS BEING A TRIBAL SELF-INSURED PLAN"

 S DIC("DR")=".03///W"

 K DD,DO

 D FILE^DICN

 D SITE(234)

 Q

SITE(ABMX) ;Add SITE multiple

 S DUZHOLD=DUZ(2)

 S DUZ(2)=0

 F  S DUZ(2)=$O(^ABMDCLM(DUZ(2))) Q:'+DUZ(2)  D

 .S DIC(0)="LX"

 .S DA(1)=ABMX

 .S DIC="^ABMDERR("_DA(1)_",31,"

 .S DIC("P")=$P(^DD(9002274.04,31,0),U,2)

 .S DINUM=DUZ(2)

 .S X=$P($G(^DIC(4,DUZ(2),0)),U)

 .S DIC("DR")=".03////W"

 .D ^DIC

 .K DA,DIC,DINUM

 S DUZ(2)=DUZHOLD

 K DUZHOLD,DLAYGO,ABMX

 Q

REINDEX ;

 S ABMHOLD=DUZ(2)

 S DUZ(2)=0

 F  S DUZ(2)=$O(^ABMDBILL(DUZ(2))) Q:'DUZ(2)  D

 .S ABMBDFN=0

 .F  S ABMBDFN=$O(^ABMDBILL(DUZ(2),ABMBDFN)) Q:'ABMBDFN  D

 ..S ABMXMT=0

 ..F  S ABMXMT=$O(^ABMDBILL(DUZ(2),ABMBDFN,74,ABMXMT)) Q:'ABMXMT  D

 ...S DA(1)=ABMBDFN

 ...S DA=ABMXMT

 ...S DIK="^ABMDBILL("_DUZ(2)_","_DA(1)_",74,"

 ...S DIK(1)=".01^AX"

 ...D EN1^DIK

 S DUZ(2)=ABMHOLD

 Q

ABMP263   ; IHS/SD/SDR - 3P BILLING 2.6 Patch 3 PRE/POST INIT ;  

 +1       ;;2.6;IHS Third Party Billing System;**3**;NOV 12, 2009

 +2       ;

PRE       ;

 +1        QUIT 

POST      ;

 +1       ;audit 3P Parameters, current default fee sched

           DO TURNON^DIAUTL(9002274.5,.09,"y")

 +2       ;audit 3P Insurer file, visit type mult, fee sched

           DO TURNON^DIAUTL(9002274.091,.05,"y")

 +3       ;error codes for claim editor

           DO ERRCD

 +4       ;run new cross reference for 3P Bill file, Re-export multiple

           DO REINDEX

 +5        QUIT 

ERRCD     ;

 +1       ;234 - tribal self-insured

 +2        KILL DIC,X

 +3        SET DIC="^ABMDERR("

 +4        SET DIC(0)="LM"

 +5        SET DINUM=234

 +6        SET X="INSURER DESIGNED AS BEING A TRIBAL SELF-INSURED PLAN"

 +7        SET DIC("DR")=".03///W"

 +8        KILL DD,DO

 +9        DO FILE^DICN

 +10       DO SITE(234)

 +11       QUIT 

SITE(ABMX) ;Add SITE multiple

 +1        SET DUZHOLD=DUZ(2)

 +2        SET DUZ(2)=0

 +3        FOR 

               SET DUZ(2)=$ORDER(^ABMDCLM(DUZ(2)))

               IF '+DUZ(2)

                   QUIT 

               Begin DoDot:1

 +4                SET DIC(0)="LX"

 +5                SET DA(1)=ABMX

 +6                SET DIC="^ABMDERR("_DA(1)_",31,"

 +7                SET DIC("P")=$PIECE(^DD(9002274.04,31,0),U,2)

 +8                SET DINUM=DUZ(2)

 +9                SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)

 +10               SET DIC("DR")=".03////W"

 +11               DO ^DIC

 +12               KILL DA,DIC,DINUM

               End DoDot:1

 +13       SET DUZ(2)=DUZHOLD

 +14       KILL DUZHOLD,DLAYGO,ABMX

 +15       QUIT 

REINDEX   ;

 +1        SET ABMHOLD=DUZ(2)

 +2        SET DUZ(2)=0

 +3        FOR 

               SET DUZ(2)=$ORDER(^ABMDBILL(DUZ(2)))

               IF 'DUZ(2)

                   QUIT 

               Begin DoDot:1

 +4                SET ABMBDFN=0

 +5                FOR 

                       SET ABMBDFN=$ORDER(^ABMDBILL(DUZ(2),ABMBDFN))

                       IF 'ABMBDFN

                           QUIT 

                       Begin DoDot:2

 +6                        SET ABMXMT=0

 +7                        FOR 

                               SET ABMXMT=$ORDER(^ABMDBILL(DUZ(2),ABMBDFN,74,ABMXMT))

                               IF 'ABMXMT

                                   QUIT 

                               Begin DoDot:3

 +8                                SET DA(1)=ABMBDFN

 +9                                SET DA=ABMXMT

 +10                               SET DIK="^ABMDBILL("_DUZ(2)_","_DA(1)_",74,"

 +11                               SET DIK(1)=".01^AX"

 +12                               DO EN1^DIK

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +13       SET DUZ(2)=ABMHOLD

 +14       QUIT