Routine: IBCMENU

IBCMENU	;ALB/MRL,MJB - UB-82 BILLING MENU  ;01 JUN 88 12:00

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

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

	;MAP TO DGCRMENU

	D DT^DICRW S DIK="^DOPT(""IBCMENU"","

	G:$D(^DOPT("IBCMENU",16)) A S ^DOPT("IBCMENU",0)="Billing Option^1N^" F I=1:1 S X=$T(@I) Q:X=""  S ^DOPT("IBCMENU",I,0)=$P(X,";;",2,99)

	D IXALL^DIK

A	W ! S DIC="^DOPT(""IBCMENU"",",DIC(0)="QEAM" D ^DIC Q:Y'>0  D @+Y G A

1	;;ACTIVATE/INACTIVATE REVENUE CODES

	W ! S DIC="^DGCR(399.2,",DIC(0)="AEQM" D ^DIC G KILL:Y'>0 S DA=+Y,DIE=DIC,DR="[IB ACTIVATE]" D ^DIE K DR G 1

2	;;AUTHORIZE BILL GENERATION

	D KILL S IBAC=3 D AUT^IBCB,KILL Q

3	;;BILL STATUS REPORT

	D ^IBOSTUS,KILL

	I $D(ZTQUEUED) S ZTREQ="@"

4	;;CANCEL BILL

	D KILL S IBCAN=1 D ^IBCC,KILL Q

5	;;ENTER/EDIT BILLING INFORMATION

	D KILL S IBAC=1 D EDI^IBCB,KILL Q

6	;;PRINT BILL

	D KILL S IBAC=4 D GEN^IBCB,KILL

	I $D(ZTQUEUED) S ZTREQ="@"

7	;;INPATIENTS WITH INSURANCE (NSC)

	D KILL S IBINPT=1 D INP^IBCONSC,KILL Q

8	;;MAS BILLING LOG

	D ^IBOMBL,KILL Q

9	;;OUTPATIENTS WITH INSURANCE (NSC)

	D KILL S IBOPT=1 D EN^IBCONSC,KILL Q

10	;;PARAMETER ENTRY/EDIT

	D ^IBEPAR,KILL Q

11	;;PATIENT BILLING INQUIRY

	D ^IBCNQ,KILL Q

12	;;REOPEN BILLING RECORD

	W !,"NOT AVAILABLE",! Q  ;D ^IBCREO,KILL Q

13	;;REPORT OF RATE TYPE TOTALS

	D ^IBORT,KILL

	I $D(ZTQUEUED) S ZTREQ="@"

14	;;REVIEW BILL

	D KILL S IBAC=2 D REV^IBCB,KILL Q

15	;;UPDATE RATE TYPE FILE

	W ! S DIC="^DGCR(399.3,",DIC(0)="AEQMZL" D ^DIC G KILL:Y'>0 S DA=+Y,DIE=DIC,DR="[IB RATE EDIT]" D ^DIE

	D KILL Q

16	;;CLONE A BILL (COPY AND CANCEL)

	D KILL,^IBCCC,KILL Q

KILL	S IBKILL=1 D Q5^IBCVA K IBADI,IB00,DGCT1,IBPAR,IB,IBEDIT,IBK,IBPRNT,IBN,IBNEW,IBTAG,IBAUT,IBCAN,IBZ,IBZ,IBOUT,IBKILL,IBAC,IBDPT,IBDG,DGS,IBCCC,IBCCCC,IBIFN,DFN

	K IB1,IBA,IBA2,IBAC1,IBAD,IBADD1,IBDATA,IBU,IBUN,IBV1,IBVI,IBVO,IBW,IBWW,DGDRS1,IBX1,IBX2,X3,IBX3,DIC,G,%H,J1,X,X1,X2,XZ,Y,Z0,PRCASV,IBPNT,IBIFN2

	K IBYN,IBUB,IBU1,IBOPT,IBDR,IBABRT,IB6,IB7,IB8,IB9,IBCT,IBDIA,IBDX,IBDXC,IBHCN,IBNC,IBOPC,IBP,IBSP,IBUC,IBWE,IBWO,DGMTLL,DGPCM,DGPT,F,VAERR,VA,IBQUIT,PRCAPAYR,PTF,DGPTUPDT Q

	K IBEPAR

	;IBCMENU

IBCMENU   ;ALB/MRL,MJB - UB-82 BILLING MENU  ;01 JUN 88 12:00

 +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 DGCRMENU

 +5       ;

 +6        DO DT^DICRW

           SET DIK="^DOPT(""IBCMENU"","

 +7        IF $DATA(^DOPT("IBCMENU",16))

               GOTO A

           SET ^DOPT("IBCMENU",0)="Billing Option^1N^"

           FOR I=1:1

               SET X=$TEXT(@I)

               IF X=""

                   QUIT

               SET ^DOPT("IBCMENU",I,0)=$PIECE(X,";;",2,99)

 +8        DO IXALL^DIK

A          WRITE !

           SET DIC="^DOPT(""IBCMENU"","

           SET DIC(0)="QEAM"

           DO ^DIC

           IF Y'>0

               QUIT

           DO @+Y

           GOTO A

1         ;;ACTIVATE/INACTIVATE REVENUE CODES

 +1        WRITE !

           SET DIC="^DGCR(399.2,"

           SET DIC(0)="AEQM"

           DO ^DIC

           IF Y'>0

               GOTO KILL

           SET DA=+Y

           SET DIE=DIC

           SET DR="[IB ACTIVATE]"

           DO ^DIE

           KILL DR

           GOTO 1

 +2       ;

2         ;;AUTHORIZE BILL GENERATION

 +1        DO KILL

           SET IBAC=3

           DO AUT^IBCB

           DO KILL

           QUIT

 +2       ;

3         ;;BILL STATUS REPORT

 +1        DO ^IBOSTUS

           DO KILL

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        QUIT

 +4       ;

4         ;;CANCEL BILL

 +1        DO KILL

           SET IBCAN=1

           DO ^IBCC

           DO KILL

           QUIT

 +2       ;

5         ;;ENTER/EDIT BILLING INFORMATION

 +1        DO KILL

           SET IBAC=1

           DO EDI^IBCB

           DO KILL

           QUIT

 +2       ;

6         ;;PRINT BILL

 +1        DO KILL

           SET IBAC=4

           DO GEN^IBCB

           DO KILL

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        QUIT

 +4       ;

7         ;;INPATIENTS WITH INSURANCE (NSC)

 +1        DO KILL

           SET IBINPT=1

           DO INP^IBCONSC

           DO KILL

           QUIT

 +2       ;

8         ;;MAS BILLING LOG

 +1        DO ^IBOMBL

           DO KILL

           QUIT

 +2       ;

9         ;;OUTPATIENTS WITH INSURANCE (NSC)

 +1        DO KILL

           SET IBOPT=1

           DO EN^IBCONSC

           DO KILL

           QUIT

 +2       ;

10        ;;PARAMETER ENTRY/EDIT

 +1        DO ^IBEPAR

           DO KILL

           QUIT

 +2       ;

11        ;;PATIENT BILLING INQUIRY

 +1        DO ^IBCNQ

           DO KILL

           QUIT

 +2       ;

12        ;;REOPEN BILLING RECORD

 +1       ;D ^IBCREO,KILL Q

           WRITE !,"NOT AVAILABLE",!

           QUIT

 +2       ;

13        ;;REPORT OF RATE TYPE TOTALS

 +1        DO ^IBORT

           DO KILL

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        QUIT

 +4       ;

14        ;;REVIEW BILL

 +1        DO KILL

           SET IBAC=2

           DO REV^IBCB

           DO KILL

           QUIT

 +2       ;

15        ;;UPDATE RATE TYPE FILE

 +1        WRITE !

           SET DIC="^DGCR(399.3,"

           SET DIC(0)="AEQMZL"

           DO ^DIC

           IF Y'>0

               GOTO KILL

           SET DA=+Y

           SET DIE=DIC

           SET DR="[IB RATE EDIT]"

           DO ^DIE

 +2        DO KILL

           QUIT

16        ;;CLONE A BILL (COPY AND CANCEL)

 +1        DO KILL

           DO ^IBCCC

           DO KILL

           QUIT

 +2       ;

KILL       SET IBKILL=1

           DO Q5^IBCVA

           KILL IBADI,IB00,DGCT1,IBPAR,IB,IBEDIT,IBK,IBPRNT,IBN,IBNEW,IBTAG,IBAUT,IBCAN,IBZ,IBZ,IBOUT,IBKILL,IBAC,IBDPT,IBDG,DGS,IBCCC,IBCCCC,IBIFN,DFN

 +1        KILL IB1,IBA,IBA2,IBAC1,IBAD,IBADD1,IBDATA,IBU,IBUN,IBV1,IBVI,IBVO,IBW,IBWW,DGDRS1,IBX1,IBX2,X3,IBX3,DIC,G,%H,J1,X,X1,X2,XZ,Y,Z0,PRCASV,IBPNT,IBIFN2

 +2        KILL IBYN,IBUB,IBU1,IBOPT,IBDR,IBABRT,IB6,IB7,IB8,IB9,IBCT,IBDIA,IBDX,IBDXC,IBHCN,IBNC,IBOPC,IBP,IBSP,IBUC,IBWE,IBWO,DGMTLL,DGPCM,DGPT,F,VAERR,VA,IBQUIT,PRCAPAYR,PTF,DGPTUPDT

           QUIT

 +3        KILL IBEPAR

 +4       ;IBCMENU

IBCMENU.m