ABMPT269.m

ABMPT269 ; IHS/SD/SDR - 3P BILLING 2.6 Patch 9 POST INIT ;  

 ;;2.6;IHS Third Party Billing;**9**;NOV 12, 2009

 ;

 Q

POST ;

 D ^XBFMK

 S DIE="^ABMMUPRM("

 S DA=1

 S DR=".01////PATIENT VOLUME"

 D ^DIE

ERRCODES ;

 ;241 - CPT NARRATIVE missing

 K DIC,X

 S DIC="^ABMDERR("

 S DIC(0)="LM"

 S DINUM=241

 S X="CPT NARRATIVE missing"

 S DIC("DR")=".02///Populate CPT NARRATIVE"

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

 K DD,DO

 D FILE^DICN

 D SITE(241)

 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

 Q

ABMPT269  ; IHS/SD/SDR - 3P BILLING 2.6 Patch 9 POST INIT ;  

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

 +2       ;

 +3        QUIT 

POST      ;

 +1        DO ^XBFMK

 +2        SET DIE="^ABMMUPRM("

 +3        SET DA=1

 +4        SET DR=".01////PATIENT VOLUME"

 +5        DO ^DIE

ERRCODES  ;

 +1       ;241 - CPT NARRATIVE missing

 +2        KILL DIC,X

 +3        SET DIC="^ABMDERR("

 +4        SET DIC(0)="LM"

 +5        SET DINUM=241

 +6        SET X="CPT NARRATIVE missing"

 +7        SET DIC("DR")=".02///Populate CPT NARRATIVE"

 +8        SET DIC("DR")=DIC("DR")_";.03///W"

 +9        KILL DD,DO

 +10       DO FILE^DICN

 +11       DO SITE(241)

 +12       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 

 +16       QUIT