IBCBR.m

IBCBR	;ALB/AAS - ADD/EDIT BILLING RATES FILE; 3 MAY 90

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

	;MAP TO DGCRBR

	;

	;ask date, bed section, revenue code, amount, the file.

	;     reask revenue code until null

	;     reask bed section untill null - then revenue code

	;     reask date until null .....

ADD	W ! S %DT="AEX",%DT("A")="Select BILLING RATE EFFECTIVE DATE: " D ^%DT G:Y<1 END1 S IBEFDT=+Y

	F I=0:0 D BS G:IBBS<1 ADD

	Q

BS	W ! S DIC("S")="I $P(^(0),U,5)",DIC="^DGCR(399.1,",DIC(0)="AEQM",DIC("A")="   Select BILLING BEDSECTION: " D ^DIC K DIC S IBBS=+Y Q:IBBS<1

	F J=0:0 D REV Q:IBREV<1

	Q

REV	W ! S DIC("S")="I $P(^(0),U,3)",DIC="^DGCR(399.2,",DIC(0)="AEQM",DIC("A")="      Select REVENUE CODE: " D ^DIC K DIC S IBREV=+Y Q:IBREV<1

	I $D(^DGCR(399.5,"AIVDT",IBBS,-IBEFDT,IBREV)) S DIC(0)="EMQF",X=IBEFDT,DIC="^DGCR(399.5,",DIC("S")="I $P(^(0),U,2)=IBBS,$P(^(0),U,3)=IBREV" D ^DIC K DIC D NEW:+Y<1 Q:Y<1  S DA=+Y D EDIT Q

	W !,"Filing New Entry!" D FILE,EDIT

	Q

FILE	S:'$D(DIC(0)) DIC(0)="L" S DIC="^DGCR(399.5,",X=IBEFDT,DIC("DR")=".02////"_IBBS_";.03////"_IBREV K DD,DO D FILE^DICN S DA=+Y

	Q

	;

NEW	;ask to add new entry from fast

	S Y=IBEFDT X ^DD("DD") W !?3,"ARE YOU ADDING '",Y,"' AS A NEW BILLING RATES" D YN^DICN Q:%=-1!(%=2)

	I '% W !!?3,"Enter 'YES' to add this as a new BILLING RATES",!?3,"or Enter 'NO' to not add a new entry",! G NEW

	S DIC(0)="EQL" D FILE Q

	Q

	;

EN1	;edit file entry, do lookup, then edit.

	W ! S DIC("A")="Select BEDSECTION: ",DIC="^DGCR(399.1,",DIC(0)="AEQMN",DIC("S")="I $P(^(0),U,5)" D ^DIC K DIC G:Y<1 END S IBBS=+Y D BR G EN1

	Q

BR	W ! S DIC("DR")=".02///"_IBBS,DIC("S")="I $P(^(0),U,2)=IBBS",DIC="^DGCR(399.5,",DIC(0)="AEQL" D ^DIC K DIC Q:Y<1  S DA=+Y D EDIT G BR

	;

EDIT	S (DIC,DIE)="^DGCR(399.5,",DR=".01:99" D ^DIE

	Q

	;

END1	D ENR^IBEMTO K IBRUN ; bill MT OPT charges awaiting the new copay rate

END	K I,J,X,Y,%DT,DA,DIC,DIE,DR,IBBS,IBREV,IBEFDT

	Q

	;

REDO	;re-index the aivdt x-ref in billing rates file.

	K ^DGCR(399.5,"AIVDT")

	S IBJ=0 F IBI=0:0 S IBJ=$O(^DGCR(399.5,IBJ)) Q:'IBJ  I $D(^DGCR(399.5,IBJ,0)) S X=^(0) I $P(X,"^",2)]"",$P(X,"^",3)]"" S ^DGCR(399.5,"AIVDT",$P(X,"^",2),-($P(X,"^")),$P(X,"^",3),IBJ)=""

IBCBR     ;ALB/AAS - ADD/EDIT BILLING RATES FILE; 3 MAY 90

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;MAP TO DGCRBR

 +5       ;

 +6       ;ask date, bed section, revenue code, amount, the file.

 +7       ;     reask revenue code until null

 +8       ;     reask bed section untill null - then revenue code

 +9       ;     reask date until null .....

ADD        WRITE !

           SET %DT="AEX"

           SET %DT("A")="Select BILLING RATE EFFECTIVE DATE: "

           DO ^%DT

           IF Y<1

               GOTO END1

           SET IBEFDT=+Y

 +1        FOR I=0:0

               DO BS

               IF IBBS<1

                   GOTO ADD

 +2        QUIT 

BS         WRITE !

           SET DIC("S")="I $P(^(0),U,5)"

           SET DIC="^DGCR(399.1,"

           SET DIC(0)="AEQM"

           SET DIC("A")="   Select BILLING BEDSECTION: "

           DO ^DIC

           KILL DIC

           SET IBBS=+Y

           IF IBBS<1

               QUIT 

 +1        FOR J=0:0

               DO REV

               IF IBREV<1

                   QUIT 

 +2        QUIT 

REV        WRITE !

           SET DIC("S")="I $P(^(0),U,3)"

           SET DIC="^DGCR(399.2,"

           SET DIC(0)="AEQM"

           SET DIC("A")="      Select REVENUE CODE: "

           DO ^DIC

           KILL DIC

           SET IBREV=+Y

           IF IBREV<1

               QUIT 

 +1        IF $DATA(^DGCR(399.5,"AIVDT",IBBS,-IBEFDT,IBREV))

               SET DIC(0)="EMQF"

               SET X=IBEFDT

               SET DIC="^DGCR(399.5,"

               SET DIC("S")="I $P(^(0),U,2)=IBBS,$P(^(0),U,3)=IBREV"

               DO ^DIC

               KILL DIC

               IF +Y<1

                   DO NEW

               IF Y<1

                   QUIT 

               SET DA=+Y

               DO EDIT

               QUIT 

 +2        WRITE !,"Filing New Entry!"

           DO FILE

           DO EDIT

 +3        QUIT 

FILE       IF '$DATA(DIC(0))

               SET DIC(0)="L"

           SET DIC="^DGCR(399.5,"

           SET X=IBEFDT

           SET DIC("DR")=".02////"_IBBS_";.03////"_IBREV

           KILL DD,DO

           DO FILE^DICN

           SET DA=+Y

 +1        QUIT 

 +2       ;

NEW       ;ask to add new entry from fast

 +1        SET Y=IBEFDT

           XECUTE ^DD("DD")

           WRITE !?3,"ARE YOU ADDING '",Y,"' AS A NEW BILLING RATES"

           DO YN^DICN

           IF %=-1!(%=2)

               QUIT 

 +2        IF '%

               WRITE !!?3,"Enter 'YES' to add this as a new BILLING RATES",!?3,"or Enter 'NO' to not add a new entry",!

               GOTO NEW

 +3        SET DIC(0)="EQL"

           DO FILE

           QUIT 

 +4        QUIT 

 +5       ;

EN1       ;edit file entry, do lookup, then edit.

 +1        WRITE !

           SET DIC("A")="Select BEDSECTION: "

           SET DIC="^DGCR(399.1,"

           SET DIC(0)="AEQMN"

           SET DIC("S")="I $P(^(0),U,5)"

           DO ^DIC

           KILL DIC

           IF Y<1

               GOTO END

           SET IBBS=+Y

           DO BR

           GOTO EN1

 +2        QUIT 

BR         WRITE !

           SET DIC("DR")=".02///"_IBBS

           SET DIC("S")="I $P(^(0),U,2)=IBBS"

           SET DIC="^DGCR(399.5,"

           SET DIC(0)="AEQL"

           DO ^DIC

           KILL DIC

           IF Y<1

               QUIT 

           SET DA=+Y

           DO EDIT

           GOTO BR

 +1       ;

EDIT       SET (DIC,DIE)="^DGCR(399.5,"

           SET DR=".01:99"

           DO ^DIE

 +1        QUIT 

 +2       ;

END1      ; bill MT OPT charges awaiting the new copay rate

           DO ENR^IBEMTO

           KILL IBRUN

END        KILL I,J,X,Y,%DT,DA,DIC,DIE,DR,IBBS,IBREV,IBEFDT

 +1        QUIT 

 +2       ;

REDO      ;re-index the aivdt x-ref in billing rates file.

 +1        KILL ^DGCR(399.5,"AIVDT")

 +2        SET IBJ=0

           FOR IBI=0:0

               SET IBJ=$ORDER(^DGCR(399.5,IBJ))

               IF 'IBJ

                   QUIT 

               IF $DATA(^DGCR(399.5,IBJ,0))

                   SET X=^(0)

                   IF $PIECE(X,"^",2)]""

                       IF $PIECE(X,"^",3)]""

                           SET ^DGCR(399.5,"AIVDT",$PIECE(X,"^",2),-($PIECE(X,"^")),$PIECE(X,"^",3),IBJ)=""