Routine: ABMPST26

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

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

POST ;

 D ERRCODES  ;new error codes in 3P Error Codes file

ERRCODES ;

 ;233 - CPT CODE REQUIRES LAB TEST RESULT TO BE ENTERED

 K DIC,X

 S DIC="^ABMDERR("

 S DIC(0)="LM"

 S DINUM=233

 S X="CPT code requires lab test result to be entered"

 S DIC("DR")=".02///Enter lab test result for CPT"

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

 K DD,DO

 D FILE^DICN

 D SITE(233)

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////"_$S((DA(1)=231):"W",1:"E")

 .D ^DIC

 .K DA,DIC,DINUM

 S DUZ(2)=DUZHOLD

 K DUZHOLD,DLAYGO,ABMX

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

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

POST      ;

 +1       ;new error codes in 3P Error Codes file

           DO ERRCODES

 +2        QUIT

ERRCODES  ;

 +1       ;233 - CPT CODE REQUIRES LAB TEST RESULT TO BE ENTERED

 +2        KILL DIC,X

 +3        SET DIC="^ABMDERR("

 +4        SET DIC(0)="LM"

 +5        SET DINUM=233

 +6        SET X="CPT code requires lab test result to be entered"

 +7        SET DIC("DR")=".02///Enter lab test result for CPT"

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

 +9        KILL DD,DO

 +10       DO FILE^DICN

 +11       DO SITE(233)

 +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////"_$SELECT((DA(1)=231):"W",1:"E")

 +11               DO ^DIC

 +12               KILL DA,DIC,DINUM

               End DoDot:1

 +13       SET DUZ(2)=DUZHOLD

 +14       KILL DUZHOLD,DLAYGO,ABMX

 +15       QUIT

ABMPST26.m