ABMDVFEE.m

ABMDVFEE ; IHS/SD/SDR - VIEW CPT FEES ;

 ;;2.6;IHS Third Party Billing System;**9,21,27**;NOV 12, 2009;Build 486

 ;IHS/SD/SDR 2.6*21 HEAT135354 fixed display of code when one is selected; was printing a dash, no description, and 0.00 all the time, no matter the charge.

 ;IHS/SD/SDR 2.6*27 CR8894 Fixed display to show short description for CPT if ?? entered by user

 ;

 S U="^" W !

FEE K DIC

 S DIC="^ABMDFEE(",DIC(0)="QEAML"

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

 S:$P($G(^ABMDPARM(DUZ(2),1,0)),U,9)]"" DIC("B")=$P(^(0),U,9)

 S DIC("S")="I DUZ(2)=$P($G(^ABMDFEE(X,0)),""^"",4)"

 S DIC("DR")=".02;.04////"_DUZ(2)  ;abm*2.6*1 NO HEAT

 D ^DIC

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

 I +Y<1 G FEE

 S ABM("FEE")=+Y

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

 S DIR(0)="SO^1:MEDICAL FEES;2:SURGICAL FEES;3:RADIOLOGY FEES;4:LABORATORY FEES;5:ANESTHESIA FEES;6:DENTAL FEES;7:REVENUE CODE;8:HCPCS FEES;9:DRUG FEES;10:CHARGE MASTER"

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

 D ^DIR K DIR

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

 S ABM=+Y

 ;

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

EDIT K DIC

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

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

 S:'$D(@(DIC_"0)")) @(DIC_"0)")="^9002274.01"_ABM("SUB")_"P"

 ;S ABM("DICS")=9002274.01_ABM("SUB") X:$D(^DD(ABM("DICS"),.01,12.1)) ^DD(ABM("DICS"),.01,12.1)  ;abm*2.6*27 IHS/SD/SDR CR8894

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

 ;I ABM=6 S DIC("W")="W "" - "",$P($G(^AUTTADA(Y,0)),U,2),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),21,Y,DT),U),"","",2),9)"  ;abm*2.6*27 IHS/SD/SDR CR8894

 I ABM=6 S DIC("W")="S ABMR(""CODE"")=$E(Y,2,5) W "" - "",$E($P($G(^AUTTADA($P(^ABMDFEE(DA(1),21,Y,0),U),0)),U,2),1,45),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),21,Y,DT),U),"","",2),9)"  ;abm*2.6*27 IHS/SD/SDR CR8894

 ;I "123458"[ABM S DIC("W")="W "" - "",$P($$CPT^ABMCVAPI(Y,DT),U,3),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),Y,DT),U),"","",2),9)"  ;CSV-c  ;abm*2.6*21 IHS/SD/SDR HEAT135354

 ;I "123458"[ABM S DIC("W")="W "" - "",$P($$CPT^ABMCVAPI(X,DT),U,3),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),$P($$CPT^ABMCVAPI(X,DT),U),DT),U),"","",2),9)"  ;CSV-c  ;abm*2.6*21 IHS/SD/SDR HEAT135354  ;abm*2.6*27 IHS/SD/SDR CR8894

 ;start new abm*2.6*27 IHS/SD/SDR CR8894

 I "123458"[ABM D

 .S DIC("W")=" W "" - "",$P($$CPT^ABMCVAPI(+Y,DT),U,3),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),$P($$CPT^ABMCVAPI(+Y,DT),U),DT),U),"","",2),9)"

 ;

 I ABM=9 S DIC("W")="W ?50,$P($G(^PSDRUG(Y,2)),U,4),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),Y,DT),U),"","",2),9)"

 I ABM=10 S DIC("W")="W ?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),Y,DT),U),"","",2),9)"

 ;end new abm*2.6*27 IHS/SD/SDR CR8894

 ;

 W !!

 S DIC(0)="QEAM"

 D ^DIC K DIC

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

 I +Y<1 G EDIT

EFFDT ;

 S ABMCODE=+Y

 W !!,"Eff. Date",?16,"Global",?25,"Technical",?35,"Professional",?48,"Updated By",?69,"Updated on"

 S ABMEFDT=0

 F  S ABMEFDT=$O(^ABMDFEE(ABM("FEE"),ABM("SUB"),ABMCODE,1,ABMEFDT)) Q:'ABMEFDT  D

 .S ABMREC=$G(^ABMDFEE(ABM("FEE"),ABM("SUB"),ABMCODE,1,ABMEFDT,0))

 .W !,$$SDT^ABMDUTL($P(ABMREC,U))

 .W ?12,$J($FN($P(ABMREC,U,2),",",2),10),?24,$J($FN($P(ABMREC,U,3),",",2),10),?37,$J($FN($P(ABMREC,U,4),",",2),10)

 .W ?48,$E($$GET1^DIQ(200,$P(ABMREC,U,6),".01","E"),1,19),?69,$$SDT^ABMDUTL($P(ABMREC,U,5))

 ;

 G EDIT

 ;

XIT K ABM,DIR,DIC,DIE

 Q

ABMDVFEE  ; IHS/SD/SDR - VIEW CPT FEES ;

 +1       ;;2.6;IHS Third Party Billing System;**9,21,27**;NOV 12, 2009;Build 486

 +2       ;IHS/SD/SDR 2.6*21 HEAT135354 fixed display of code when one is selected; was printing a dash, no description, and 0.00 all the time, no matter the charge.

 +3       ;IHS/SD/SDR 2.6*27 CR8894 Fixed display to show short description for CPT if ?? entered by user

 +4       ;

 +5        SET U="^"

           WRITE !

FEE        KILL DIC

 +1        SET DIC="^ABMDFEE("

           SET DIC(0)="QEAML"

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

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

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

 +4        SET DIC("S")="I DUZ(2)=$P($G(^ABMDFEE(X,0)),""^"",4)"

 +5       ;abm*2.6*1 NO HEAT

           SET DIC("DR")=".02;.04////"_DUZ(2)

 +6        DO ^DIC

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

               GOTO XIT

 +8        IF +Y<1

               GOTO FEE

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

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

 +1        SET DIR(0)="SO^1:MEDICAL FEES;2:SURGICAL FEES;3:RADIOLOGY FEES;4:LABORATORY FEES;5:ANESTHESIA FEES;6:DENTAL FEES;7:REVENUE CODE;8:HCPCS FEES;9:DRUG FEES;10:CHARGE MASTER"

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

 +3        DO ^DIR

           KILL DIR

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

               GOTO XIT

 +5        SET ABM=+Y

 +6       ;

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

EDIT       KILL DIC

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

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

 +3        IF '$DATA(@(DIC_"0)"))

               SET @(DIC_"0)")="^9002274.01"_ABM("SUB")_"P"

 +4       ;S ABM("DICS")=9002274.01_ABM("SUB") X:$D(^DD(ABM("DICS"),.01,12.1)) ^DD(ABM("DICS"),.01,12.1)  ;abm*2.6*27 IHS/SD/SDR CR8894

 +5        IF ABM=7

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

 +6       ;I ABM=6 S DIC("W")="W "" - "",$P($G(^AUTTADA(Y,0)),U,2),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),21,Y,DT),U),"","",2),9)"  ;abm*2.6*27 IHS/SD/SDR CR8894

 +7       ;abm*2.6*27 IHS/SD/SDR CR8894

           IF ABM=6

               SET DIC("W")="S ABMR(""CODE"")=$E(Y,2,5) W "" - "",$E($P($G(^AUTTADA($P(^ABMDFEE(DA(1),21,Y,0),U),0)),U,2),1,45),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),21,Y,DT),U),"","",2),9)"

 +8       ;I "123458"[ABM S DIC("W")="W "" - "",$P($$CPT^ABMCVAPI(Y,DT),U,3),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),Y,DT),U),"","",2),9)"  ;CSV-c  ;abm*2.6*21 IHS/SD/SDR HEAT135354

 +9       ;I "123458"[ABM S DIC("W")="W "" - "",$P($$CPT^ABMCVAPI(X,DT),U,3),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),$P($$CPT^ABMCVAPI(X,DT),U),DT),U),"","",2),9)"  ;CSV-c  ;abm*2.6*21 IHS/SD/SDR HEAT135354  ;abm*2.6*27 IHS/SD/SDR CR8894

 +10      ;start new abm*2.6*27 IHS/SD/SDR CR8894

 +11       IF "123458"[ABM

               Begin DoDot:1

 +12               SET DIC("W")=" W "" - "",$P($$CPT^ABMCVAPI(+Y,DT),U,3),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),$P($$CPT^ABMCVAPI(+Y,DT),U),DT),U),"","",2),9)"

               End DoDot:1

 +13      ;

 +14       IF ABM=9

               SET DIC("W")="W ?50,$P($G(^PSDRUG(Y,2)),U,4),?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),Y,DT),U),"","",2),9)"

 +15       IF ABM=10

               SET DIC("W")="W ?65,$J($FN($P($$ONE^ABMFEAPI(DA(1),ABM(""SUB""),Y,DT),U),"","",2),9)"

 +16      ;end new abm*2.6*27 IHS/SD/SDR CR8894

 +17      ;

 +18       WRITE !!

 +19       SET DIC(0)="QEAM"

 +20       DO ^DIC

           KILL DIC

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

               GOTO SEL

 +22       IF +Y<1

               GOTO EDIT

EFFDT     ;

 +1        SET ABMCODE=+Y

 +2        WRITE !!,"Eff. Date",?16,"Global",?25,"Technical",?35,"Professional",?48,"Updated By",?69,"Updated on"

 +3        SET ABMEFDT=0

 +4        FOR 

               SET ABMEFDT=$ORDER(^ABMDFEE(ABM("FEE"),ABM("SUB"),ABMCODE,1,ABMEFDT))

               IF 'ABMEFDT

                   QUIT 

               Begin DoDot:1

 +5                SET ABMREC=$GET(^ABMDFEE(ABM("FEE"),ABM("SUB"),ABMCODE,1,ABMEFDT,0))

 +6                WRITE !,$$SDT^ABMDUTL($PIECE(ABMREC,U))

 +7                WRITE ?12,$JUSTIFY($FNUMBER($PIECE(ABMREC,U,2),",",2),10),?24,$JUSTIFY($FNUMBER($PIECE(ABMREC,U,3),",",2),10),?37,$JUSTIFY($FNUMBER($PIECE(ABMREC,U,4),",",2),10)

 +8                WRITE ?48,$EXTRACT($$GET1^DIQ(200,$PIECE(ABMREC,U,6),".01","E"),1,19),?69,$$SDT^ABMDUTL($PIECE(ABMREC,U,5))

               End DoDot:1

 +9       ;

 +10       GOTO EDIT

 +11      ;

XIT        KILL ABM,DIR,DIC,DIE

 +1        QUIT