- 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)=""
