ABMDRFEE.m

ABMDRFEE ; IHS/ASDST/DMJ - REPORT OF 3P FEE SCHEDULES ;

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

 ;Original;TMD;

 ;

 S U="^"

FEE W ! K DIC S DIC="^ABMDFEE(",DIC(0)="QEAM",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,ABM("NM")=$P(^ABMDFEE(+Y,0),U,2)

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

 K DIR S (ABM("S"),DIR(0))="SO^1:MEDICAL;2:SURGICAL-ANESTHESIA;3:RADIOLOGY;4:LABORATORY",DIR("A")="Select Desired CATEGORY" D ^DIR

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

 S ABM("CAT")=+Y,ABM("S")=$P($P($P(ABM("S"),U,2),";",+Y),":",2)

 ;

W1 W !!,"NOTE: Report requires 132 Width Export Format!",! S %ZIS="Q",%ZIS("B")="",%ZIS("A")="Output DEVICE: " D ^%ZIS G:'$D(IO)!$G(POP) XIT

 D ^ABMDR16

 S ABM("IOP")=ION_";132;"_IOSL G:$D(IO("Q")) QUE

 I IO'=IO(0),$E(IOST)'="C",'$D(IO("S")),$P($G(^ABMDPARM(DUZ(2),1,0)),U,13)="Y" W !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",! G QUE

PRQUE ;EP - Entry Point for Taskman

 G ^ABMDRFE1

 ;

XIT D ^%ZISC K ABM

 Q

 ;

QUE S ZTRTN="PRQUE^ABMDRFEE",ZTDESC="REPORT OF 3P FEE SCHEDULES"

 D QUE^ABMDRUTL

 G XIT

ABMDRFEE  ; IHS/ASDST/DMJ - REPORT OF 3P FEE SCHEDULES ;

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

 +2       ;Original;TMD;

 +3       ;

 +4        SET U="^"

FEE        WRITE !

           KILL DIC

           SET DIC="^ABMDFEE("

           SET DIC(0)="QEAM"

           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

           SET ABM("NM")=$PIECE(^ABMDFEE(+Y,0),U,2)

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

 +1        KILL DIR

           SET (ABM("S"),DIR(0))="SO^1:MEDICAL;2:SURGICAL-ANESTHESIA;3:RADIOLOGY;4:LABORATORY"

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

           DO ^DIR

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

               GOTO XIT

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

           SET ABM("S")=$PIECE($PIECE($PIECE(ABM("S"),U,2),";",+Y),":",2)

 +4       ;

W1         WRITE !!,"NOTE: Report requires 132 Width Export Format!",!

           SET %ZIS="Q"

           SET %ZIS("B")=""

           SET %ZIS("A")="Output DEVICE: "

           DO ^%ZIS

           IF '$DATA(IO)!$GET(POP)

               GOTO XIT

 +1        DO ^ABMDR16

 +2        SET ABM("IOP")=ION_";132;"_IOSL

           IF $DATA(IO("Q"))

               GOTO QUE

 +3        IF IO'=IO(0)

               IF $EXTRACT(IOST)'="C"

                   IF '$DATA(IO("S"))

                       IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,13)="Y"

                           WRITE !!,"As specified in the 3P Site Parameters File FORCED QUEUEING is in effect!",!

                           GOTO QUE

PRQUE     ;EP - Entry Point for Taskman

 +1        GOTO ^ABMDRFE1

 +2       ;

XIT        DO ^%ZISC

           KILL ABM

 +1        QUIT 

 +2       ;

QUE        SET ZTRTN="PRQUE^ABMDRFEE"

           SET ZTDESC="REPORT OF 3P FEE SCHEDULES"

 +1        DO QUE^ABMDRUTL

 +2        GOTO XIT