Routine: ABMFTED

ABMFTED ; IHS/SD/SDR - Populate Effective Date for 3P Fee Table ;

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

 W !!,"This option will go through the Fee Schedules and prompt the user"

 W !,"for an effective date.  This effective date will be used during the install"

 W !,"of patch 3 to keep a history of fees for each fee schedule."

 W !!,"The following fee schedules are on your system:"

 W !,"Num",?4,"Title",?51,"Owner",?66,"Effective Date"

 S ABMT=0,ABMCNT=0

 F  S ABMT=$O(^ABMDFEE(ABMT)) Q:(+$G(ABMT)=0)  D

 .W !,$P($G(^ABMDFEE(ABMT,0)),U)

 .W ?4,$P($G(^ABMDFEE(ABMT,0)),U,2)

 .W:($P($G(^ABMDFEE(ABMT,0)),U,4)'="") ?51,$P($G(^AUTTLOC($P($G(^ABMDFEE(ABMT,0)),U,4),0)),U,2)

 .W ?66,$$SDT^ABMDUTL($P($G(^ABMDFEE(ABMT,0)),U,5))

 .S ABMCNT=+$G(ABMCNT)+1

 W !!,"If you continue you will be prompted for an effective date for each fee schedule"

 W !,"listed.  YOU CAN NOT EXIT OUT ONCE YOU START."

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

 S DIR(0)="Y"

 D ^DIR K DIR

 I +Y=0 Q  ;don't continue

 S ABMT=0

 S DIE="^ABMDFEE("

 S DIE("NO^")=""

 F  S ABMT=$O(^ABMDFEE(ABMT)) Q:(+$G(ABMT)=0)  D

 .W !,$P($G(^ABMDFEE(ABMT,0)),U),?4,$P($G(^ABMDFEE(ABMT,0)),U,2)

 .S DR=".05//"

 .I $P($G(^ABMDFEE(ABMT,0)),U,4)="" S DR=DR_";.04//"

 .S DA=ABMT

 .D ^DIE

ABMFTED   ; IHS/SD/SDR - Populate Effective Date for 3P Fee Table ;

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

 +2       ;

 +3        WRITE !!,"This option will go through the Fee Schedules and prompt the user"

 +4        WRITE !,"for an effective date.  This effective date will be used during the install"

 +5        WRITE !,"of patch 3 to keep a history of fees for each fee schedule."

 +6       ;

 +7        WRITE !!,"The following fee schedules are on your system:"

 +8        WRITE !,"Num",?4,"Title",?51,"Owner",?66,"Effective Date"

 +9       ;

 +10       SET ABMT=0

           SET ABMCNT=0

 +11       FOR

               SET ABMT=$ORDER(^ABMDFEE(ABMT))

               IF (+$GET(ABMT)=0)

                   QUIT

               Begin DoDot:1

 +12               WRITE !,$PIECE($GET(^ABMDFEE(ABMT,0)),U)

 +13               WRITE ?4,$PIECE($GET(^ABMDFEE(ABMT,0)),U,2)

 +14               IF ($PIECE($GET(^ABMDFEE(ABMT,0)),U,4)'="")

                       WRITE ?51,$PIECE($GET(^AUTTLOC($PIECE($GET(^ABMDFEE(ABMT,0)),U,4),0)),U,2)

 +15               WRITE ?66,$$SDT^ABMDUTL($PIECE($GET(^ABMDFEE(ABMT,0)),U,5))

 +16               SET ABMCNT=+$GET(ABMCNT)+1

               End DoDot:1

 +17      ;

 +18       WRITE !!,"If you continue you will be prompted for an effective date for each fee schedule"

 +19       WRITE !,"listed.  YOU CAN NOT EXIT OUT ONCE YOU START."

 +20      ;

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

 +22       SET DIR(0)="Y"

 +23       DO ^DIR

           KILL DIR

 +24      ;don't continue

           IF +Y=0

               QUIT

 +25      ;

 +26       SET ABMT=0

 +27       SET DIE="^ABMDFEE("

 +28       SET DIE("NO^")=""

 +29       FOR

               SET ABMT=$ORDER(^ABMDFEE(ABMT))

               IF (+$GET(ABMT)=0)

                   QUIT

               Begin DoDot:1

 +30               WRITE !,$PIECE($GET(^ABMDFEE(ABMT,0)),U),?4,$PIECE($GET(^ABMDFEE(ABMT,0)),U,2)

 +31               SET DR=".05//"

 +32               IF $PIECE($GET(^ABMDFEE(ABMT,0)),U,4)=""

                       SET DR=DR_";.04//"

 +33               SET DA=ABMT

 +34               DO ^DIE

               End DoDot:1

 +35       QUIT

ABMFTED.m