ABMP2613.m

ABMP2613 ; IHS/SD/SDR - 3P BILLING 2.6 Patch 13 POST INIT ;  

 ;;2.6;IHS Third Party Billing;**13**;NOV 12, 2009;Build 213

 ;

 Q

POST ;

 K DIC,X,DINUM,DR,DLAYGO

 S DIC="^ABMQUES("

 S DIC(0)="LM"

 S DLAYGO=9002274

 S DINUM=43,X="INITIAL TREATMENT DATE"

 S DIC("DR")=".02////W43;.03////ABMDE301;.04////43;1////ABMDE3C"

 K DD,DO

 D ^DIC

 S DINUM=44,X="ORD/REF/SUP PHYS FL17"

 S DIC("DR")=".02////W44;.03////ABMDE301;.04////44;1////ABMDE3C"

 K DD,DO

 D ^DIC

 ;

 I $P($G(^ABMDEXP(32,0)),U,8)'[",43" D

 .K DIC,DIE,DIR,DR,X,Y,DA

 .S DA=32

 .S DIE="^ABMDEXP("

 .S DR=".08////"_$P($G(^ABMDEXP(32,0)),U,8)_",43"

 .D ^DIE

 D EXP35  ;add new export mode 35

 ;

 F DA=32 D

 .Q:$P($G(^ABMDEXP(DA,0)),U,8)[",24"

 .K DIC,DIE,DR,X,Y

 .S DIE="^ABMDEXP("

 .S DR=".08////"_$P($G(^ABMDEXP(DA,0)),U,8)_",24"

 .D ^DIE

 ;

 D REMOVE34  ;remove questions 34 and 39 from 5010 formats

 ;

 Q

EXP35 ;

 K DIC,DR,DINUM,DLAYGO,DIE

 S DIC="^ABMDEXP("

 S DIC(0)="LM"

 S DLAYGO=9002274

 S X="CMS-1500 (02/12)",DINUM=35

 K DD,DO

 D ^DIC

 Q:Y<0

 S DA=+Y

 S DIE="^ABMDEXP("

 S DR=".04////ABMDF35;.05////ABMDF35X;.06///0;.07///OMB No. 0938-1197;.08///1,2,3,4B,5,7,9,10,15,20,22,26,28,34,35,36,38,19,41,43,44;.11////ABMDES3;.15///H"

 D ^DIE

 Q

 ;

REMOVE34 ;

 F DA=31,32,33 D

 .S ABMJ=$P($G(^ABMDEXP(DA,0)),U,8)

 .S ABMJ=$P(ABMJ,"34,")_$P(ABMJ,"34,",2)

 .S ABMJ=$P(ABMJ,"39,")_$P(ABMJ,"39,",2)

 .S DIE="^ABMDEXP("

 .S DR=".08////"_ABMJ

 .D ^DIE

 Q

ABMP2613  ; IHS/SD/SDR - 3P BILLING 2.6 Patch 13 POST INIT ;  

 +1       ;;2.6;IHS Third Party Billing;**13**;NOV 12, 2009;Build 213

 +2       ;

 +3        QUIT 

POST      ;

 +1        KILL DIC,X,DINUM,DR,DLAYGO

 +2        SET DIC="^ABMQUES("

 +3        SET DIC(0)="LM"

 +4        SET DLAYGO=9002274

 +5        SET DINUM=43

           SET X="INITIAL TREATMENT DATE"

 +6        SET DIC("DR")=".02////W43;.03////ABMDE301;.04////43;1////ABMDE3C"

 +7        KILL DD,DO

 +8        DO ^DIC

 +9        SET DINUM=44

           SET X="ORD/REF/SUP PHYS FL17"

 +10       SET DIC("DR")=".02////W44;.03////ABMDE301;.04////44;1////ABMDE3C"

 +11       KILL DD,DO

 +12       DO ^DIC

 +13      ;

 +14       IF $PIECE($GET(^ABMDEXP(32,0)),U,8)'[",43"

               Begin DoDot:1

 +15               KILL DIC,DIE,DIR,DR,X,Y,DA

 +16               SET DA=32

 +17               SET DIE="^ABMDEXP("

 +18               SET DR=".08////"_$PIECE($GET(^ABMDEXP(32,0)),U,8)_",43"

 +19               DO ^DIE

               End DoDot:1

 +20      ;add new export mode 35

           DO EXP35

 +21      ;

 +22       FOR DA=32

               Begin DoDot:1

 +23               IF $PIECE($GET(^ABMDEXP(DA,0)),U,8)[",24"

                       QUIT 

 +24               KILL DIC,DIE,DR,X,Y

 +25               SET DIE="^ABMDEXP("

 +26               SET DR=".08////"_$PIECE($GET(^ABMDEXP(DA,0)),U,8)_",24"

 +27               DO ^DIE

               End DoDot:1

 +28      ;

 +29      ;remove questions 34 and 39 from 5010 formats

           DO REMOVE34

 +30      ;

 +31       QUIT 

EXP35     ;

 +1        KILL DIC,DR,DINUM,DLAYGO,DIE

 +2        SET DIC="^ABMDEXP("

 +3        SET DIC(0)="LM"

 +4        SET DLAYGO=9002274

 +5        SET X="CMS-1500 (02/12)"

           SET DINUM=35

 +6        KILL DD,DO

 +7        DO ^DIC

 +8        IF Y<0

               QUIT 

 +9        SET DA=+Y

 +10       SET DIE="^ABMDEXP("

 +11       SET DR=".04////ABMDF35;.05////ABMDF35X;.06///0;.07///OMB No. 0938-1197;.08///1,2,3,4B,5,7,9,10,15,20,22,26,28,34,35,36,38,19,41,43,44;.11////ABMDES3;.15///H"

 +12       DO ^DIE

 +13       QUIT 

 +14      ;

REMOVE34  ;

 +1        FOR DA=31,32,33

               Begin DoDot:1

 +2                SET ABMJ=$PIECE($GET(^ABMDEXP(DA,0)),U,8)

 +3                SET ABMJ=$PIECE(ABMJ,"34,")_$PIECE(ABMJ,"34,",2)

 +4                SET ABMJ=$PIECE(ABMJ,"39,")_$PIECE(ABMJ,"39,",2)

 +5                SET DIE="^ABMDEXP("

 +6                SET DR=".08////"_ABMJ

 +7                DO ^DIE

               End DoDot:1

 +8        QUIT