ABMP2623.m

ABMP2623 ; IHS/SD/SDR - 3P BILLING 2.6 Patch 23 POST INIT ;  

 ;;2.6;IHS Third Party Billing;**23**;NOV 12, 2009;Build 427

 ;

 ;IHS/SD/SDR 2.6*23 HEAT269872 CR8904 Added Place of Service #15 Mobile Unit

 ;IHS/SD/SDR 2.6*23 CR9261 Added Place of Service #02 Telemedicine

 ;

POST ;EP

 D ECODES  ;add new 3P Codes entries

 Q

ECODES ;EP

 K DIC,X

 F ABMI=1:1 S ABMLN=$P($T(ECODETXT+ABMI),";;",2) Q:ABMLN="END"  D

 .S ABMCODE=$P(ABMLN,U)

 .I $D(^ABMDCODE("AC",$P(ABMLN,U,2),ABMCODE)) D  Q

 ..S DA=$O(^ABMDCODE("AC",$P(ABMLN,U,2),ABMCODE,0))

 ..S $P(^ABMDCODE(DA,0),U,2)=$P(ABMLN,U,2),$P(^(0),U,3)=$P(ABMLN,U,3),$P(^(0),U,4)=$P(ABMLN,U,4)

 .S ABMDESC=$P(ABMLN,U,3)

 .S ABMINAC=$P(ABMLN,U,4)

 .S DIC="^ABMDCODE("

 .S DIC(0)="ML"

 .S X=ABMCODE

 .S DIC("DR")=".02///"_$P(ABMLN,U,2)

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

 .S DIC("DR")=DIC("DR")_";.04///"_ABMINAC

 .K DD,DO

 .D FILE^DICN

 Q

 ;

ECODETXT ;

 ;;15^H^Mobile Unit

 ;;02^H^Telemedicine

 ;;END

ABMP2623  ; IHS/SD/SDR - 3P BILLING 2.6 Patch 23 POST INIT ;  

 +1       ;;2.6;IHS Third Party Billing;**23**;NOV 12, 2009;Build 427

 +2       ;

 +3       ;IHS/SD/SDR 2.6*23 HEAT269872 CR8904 Added Place of Service #15 Mobile Unit

 +4       ;IHS/SD/SDR 2.6*23 CR9261 Added Place of Service #02 Telemedicine

 +5       ;

POST      ;EP

 +1       ;add new 3P Codes entries

           DO ECODES

 +2        QUIT 

ECODES    ;EP

 +1        KILL DIC,X

 +2        FOR ABMI=1:1

               SET ABMLN=$PIECE($TEXT(ECODETXT+ABMI),";;",2)

               IF ABMLN="END"

                   QUIT 

               Begin DoDot:1

 +3                SET ABMCODE=$PIECE(ABMLN,U)

 +4                IF $DATA(^ABMDCODE("AC",$PIECE(ABMLN,U,2),ABMCODE))

                       Begin DoDot:2

 +5                        SET DA=$ORDER(^ABMDCODE("AC",$PIECE(ABMLN,U,2),ABMCODE,0))

 +6                        SET $PIECE(^ABMDCODE(DA,0),U,2)=$PIECE(ABMLN,U,2)

                           SET $PIECE(^(0),U,3)=$PIECE(ABMLN,U,3)

                           SET $PIECE(^(0),U,4)=$PIECE(ABMLN,U,4)

                       End DoDot:2

                       QUIT 

 +7                SET ABMDESC=$PIECE(ABMLN,U,3)

 +8                SET ABMINAC=$PIECE(ABMLN,U,4)

 +9                SET DIC="^ABMDCODE("

 +10               SET DIC(0)="ML"

 +11               SET X=ABMCODE

 +12               SET DIC("DR")=".02///"_$PIECE(ABMLN,U,2)

 +13               SET DIC("DR")=DIC("DR")_";.03///"_ABMDESC

 +14               SET DIC("DR")=DIC("DR")_";.04///"_ABMINAC

 +15               KILL DD,DO

 +16               DO FILE^DICN

               End DoDot:1

 +17       QUIT 

 +18      ;

ECODETXT  ;

 +1       ;;15^H^Mobile Unit

 +2       ;;02^H^Telemedicine

 +3       ;;END