- IBCMENU ;ALB/MRL,MJB - UB-82 BILLING MENU ;01 JUN 88 12:00
- ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; DBIA for reference to ^DOPT : DBIA55
- ;
- ;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="@"
- Q
- ;
- 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="@"
- Q
- ;
- 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="@"
- Q
- ;
- 14 ;; REVIEW BILL
- Q
- ;
- 15 ;;UPDATE RATE TYPE FILE
- W ! S DIC="^DGCR(399.3,",DIC(0)="AEQMZL",DLAYGO=399.3 D ^DIC K DLAYGO 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCMENU 2275 printed Feb 18, 2025@23:40:02 Page 2
- +1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; DBIA for reference to ^DOPT : DBIA55
- +5 ;
- +6 ;MAP TO DGCRMENU
- +7 ;
- +8 DO DT^DICRW
- SET DIK="^DOPT(""IBCMENU"","
- +9 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)
- +10 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 QUIT
- +2 ;
- 15 ;;UPDATE RATE TYPE FILE
- +1 WRITE !
- SET DIC="^DGCR(399.3,"
- SET DIC(0)="AEQMZL"
- SET DLAYGO=399.3
- DO ^DIC
- KILL DLAYGO
- 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
