ABMDTFE2.m

ABMDTFE2 ; IHS/ASDST/DMJ - FEE SCHEDULE for Ambulatory Surg ;

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

 ;

 ; IHS/SD/SDR - v2.6 CSV

 ;

 S U="^"

 W !

FEE K DIC S DIC="^ABMDFEE(",DIC(0)="QEAML",DIC("A")="Select FEE SCHEDULE: " S:$P($G(^ABMDPARM(DUZ(2),1,0)),U,9)]"" DIC("B")=$P(^(0),U,9) D ^DIC

 G XIT:$D(DUOUT)!$D(DTOUT)

 I +Y<1 G FEE

 S ABM("FEE")=+Y

SEL W !!,"----- FEE SCHEDULE CATEGORIES -----",!

 K DIR S DIR(0)="SO^1:MED/SURG FEES;2:PROF COMPONENT FEES;3:RADIOLOGY FEES;4:LABORATORY FEES;5:ANESTHESIA FEES;6:DENTAL FEES;7:ROOM & BOARD;8:HCPCS FEES",DIR("A")="Select Desired CATEGORY" D ^DIR

 G XIT:$D(DIROUT)!$D(DIRUT)

 S ABM=+Y

 ;

 S ABM("SUB")=$S(ABM=1:11,ABM=2:19,ABM=3:15,ABM=4:17,ABM=5:23,ABM=6:21,ABM=7:31,ABM=8:13)

 K DIC S DA(1)=ABM("FEE"),(DIC,DIE)="^ABMDFEE("_DA(1)_","_ABM("SUB")_","

 S ABM("DICS")=9002274.01_ABM("SUB") X:$D(^DD(ABM("DICS"),.01,12.1)) ^DD(ABM("DICS"),.01,12.1)

 I ABM=7 S DIC("W")="W "" - "",$P(^AUTTREVN(Y,0),U,2),?65,$J($FN($P(^ABMDFEE(DA(1),31,Y,0),U,2),"","",2),9)"

 I ABM=6 S DIC("W")="W "" - "",$P(^AUTTADA(Y,0),U,2),?65,$J($FN($P(^ABMDFEE(DA(1),21,Y,0),U,2),"","",2),9)"

 I "123458"[ABM S DIC("W")="W "" - "",$P($$CPT^ABMCVAPI(Y,""),U,3),?65,$J($FN($P(^ABMDFEE(DA(1),ABM(""SUB""),Y,0),U,2),"","",2),9)"  ;CSV-c

 S DR=".02"_$S("134"[ABM:";11",1:"")

 ;

EDIT W !! S DIC(0)="QLEAM" D ^DIC K DIC

 G SEL:X=""!$D(DUOUT)!$D(DTOUT)

 I +Y<1 G EDIT

 S DA=+Y

 K DIR S DIR(0)="NO^1:8:1",DIR("A")="Enter GROUP NUMBER" D ^DIR K DIR G SEL:$D(DIRUT) S DR=".02////"_$S(Y=1:260,Y=2:348,Y=3:400,Y=4:492,Y=5:561,Y=6:730,Y=7:779,1:844)

 D ^ABMDDIE

 G EDIT

 ;

XIT K ABM,DIR,DIC,DIE

 Q

ABMDTFE2  ; IHS/ASDST/DMJ - FEE SCHEDULE for Ambulatory Surg ;

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

 +2       ;

 +3       ; IHS/SD/SDR - v2.6 CSV

 +4       ;

 +5        SET U="^"

 +6        WRITE !

FEE        KILL DIC

           SET DIC="^ABMDFEE("

           SET DIC(0)="QEAML"

           SET DIC("A")="Select FEE SCHEDULE: "

           IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,9)]""

               SET DIC("B")=$PIECE(^(0),U,9)

           DO ^DIC

 +1        IF $DATA(DUOUT)!$DATA(DTOUT)

               GOTO XIT

 +2        IF +Y<1

               GOTO FEE

 +3        SET ABM("FEE")=+Y

SEL        WRITE !!,"----- FEE SCHEDULE CATEGORIES -----",!

 +1        KILL DIR

           SET DIR(0)="SO^1:MED/SURG FEES;2:PROF COMPONENT FEES;3:RADIOLOGY FEES;4:LABORATORY FEES;5:ANESTHESIA FEES;6:DENTAL FEES;7:ROOM & BOARD;8:HCPCS FEES"

           SET DIR("A")="Select Desired CATEGORY"

           DO ^DIR

 +2        IF $DATA(DIROUT)!$DATA(DIRUT)

               GOTO XIT

 +3        SET ABM=+Y

 +4       ;

 +5        SET ABM("SUB")=$SELECT(ABM=1:11,ABM=2:19,ABM=3:15,ABM=4:17,ABM=5:23,ABM=6:21,ABM=7:31,ABM=8:13)

 +6        KILL DIC

           SET DA(1)=ABM("FEE")

           SET (DIC,DIE)="^ABMDFEE("_DA(1)_","_ABM("SUB")_","

 +7        SET ABM("DICS")=9002274.01_ABM("SUB")

           IF $DATA(^DD(ABM("DICS"),.01,12.1))

               XECUTE ^DD(ABM("DICS"),.01,12.1)

 +8        IF ABM=7

               SET DIC("W")="W "" - "",$P(^AUTTREVN(Y,0),U,2),?65,$J($FN($P(^ABMDFEE(DA(1),31,Y,0),U,2),"","",2),9)"

 +9        IF ABM=6

               SET DIC("W")="W "" - "",$P(^AUTTADA(Y,0),U,2),?65,$J($FN($P(^ABMDFEE(DA(1),21,Y,0),U,2),"","",2),9)"

 +10      ;CSV-c

           IF "123458"[ABM

               SET DIC("W")="W "" - "",$P($$CPT^ABMCVAPI(Y,""),U,3),?65,$J($FN($P(^ABMDFEE(DA(1),ABM(""SUB""),Y,0),U,2),"","",2),9)"

 +11       SET DR=".02"_$SELECT("134"[ABM:";11",1:"")

 +12      ;

EDIT       WRITE !!

           SET DIC(0)="QLEAM"

           DO ^DIC

           KILL DIC

 +1        IF X=""!$DATA(DUOUT)!$DATA(DTOUT)

               GOTO SEL

 +2        IF +Y<1

               GOTO EDIT

 +3        SET DA=+Y

 +4        KILL DIR

           SET DIR(0)="NO^1:8:1"

           SET DIR("A")="Enter GROUP NUMBER"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO SEL

           SET DR=".02////"_$SELECT(Y=1:260,Y=2:348,Y=3:400,Y=4:492,Y=5:561,Y=6:730,Y=7:779,1:844)

 +5        DO ^ABMDDIE

 +6        GOTO EDIT

 +7       ;

XIT        KILL ABM,DIR,DIC,DIE

 +1        QUIT