- 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
