- IBCF13 ;ALB/AAS - PRINT UB-82 FROM A ; 8/2/90
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ;MAP TO DGCRP3
- ;
- ;Entry point for AR to print 2nd and 3rd Notice UB-82's
- ;Device handling to be done by calling routine
- ;Requires input - PRCASV("ARREC") = internal number of bill
- ; - PRCASV("NOTICE")= number of notice
- ;ouputs - IBAR("ERR") = error message
- ; - IBAR("OKAY") = 1 normal finish, 0 not finished
- ;
- REPRNT N I,J,DFN ;AR variables that need newing
- K IBAR("ERR")
- S IBAR("OKAY")=0 I '$D(PRCASV("ARREC"))!('$D(PRCASV("NOTICE"))) S IBAR("ERR")="MISSING INPUT VARIABLES" Q
- S IBIFN=PRCASV("ARREC"),IB0=$S($D(^DGCR(399,IBIFN,0)):^(0),1:"") I IB0="" S IBAR("ERR")="BILL NON-EXISTANT" Q
- S DGSTAT=$P(IB0,"^",13) I $S(DGSTAT=3:0,DGSTAT=4:0,1:1) S IBAR("ERR")=$S(DGSTAT=7:"BILL CANCELLED",1:"BILL STATUS INAPPROPRIATE") Q
- ; S DFN=$P(IB0,"^",2),IBPNT=PRCASV("NOTICE"),IBAC=4 D ENP^IBCF1
- ; replaced above line with following 2 lines 4/28/92 RLW
- ;S DFN=$P(IB0,"^",2),IBAC=4 I $P(^DGCR(399,IBIFN,0),"^",19)>1 D EN2^IBCF G REPRNTQ
- S DFN=$P(IB0,"^",2),IBAC=4 I $$FT^IBCU3(IBIFN)>1 D EN2^IBCF G REPRNTQ
- S IBPNT=PRCASV("NOTICE") D ENP^IBCF1
- S IBAR("OKAY")=1
- REPRNTQ K DFN,I,J
- K M,X,X2,Y,Z,VADM,VAERR,DR,DA,D1,DGBS,DGCNT,IB,IBBILL,IBBNO,IBBT,IBC,IBCPT,IBEPAR,IBDPT,IBDT,IBF,IBIP,IBLS,IBO,IBPNT,DGSTAT,IBAC,IBIFN,IB0
- K IBPTF,IBRATY,IBREV,IBREVC,IBST,IBTF,IBU,IBUTL,DGDA,DGLCNT,DGPAG,DGPT,DGRVC,DGRV,DGTOTPAG,DGTEXT,DGTEXT1,IBDI,IBDIN,IBBS,IBCC,IBPT,DGREVC,DGRSPAC,DGSM
- Q
- ;
- PRINT ;Entry for A/R to create option to print bills.
- S IBVIEW=1 D KILL^IBCMENU,GEN^IBCB,KILL^IBCMENU
- Q
- IBCF13 ;ALB/AAS - PRINT UB-82 FROM A ; 8/2/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 DGCRP3
- +5 ;
- +6 ;Entry point for AR to print 2nd and 3rd Notice UB-82's
- +7 ;Device handling to be done by calling routine
- +8 ;Requires input - PRCASV("ARREC") = internal number of bill
- +9 ; - PRCASV("NOTICE")= number of notice
- +10 ;ouputs - IBAR("ERR") = error message
- +11 ; - IBAR("OKAY") = 1 normal finish, 0 not finished
- +12 ;
- REPRNT ;AR variables that need newing
- NEW I,J,DFN
- +1 KILL IBAR("ERR")
- +2 SET IBAR("OKAY")=0
- IF '$DATA(PRCASV("ARREC"))!('$DATA(PRCASV("NOTICE")))
- SET IBAR("ERR")="MISSING INPUT VARIABLES"
- QUIT
- +3 SET IBIFN=PRCASV("ARREC")
- SET IB0=$SELECT($DATA(^DGCR(399,IBIFN,0)):^(0),1:"")
- IF IB0=""
- SET IBAR("ERR")="BILL NON-EXISTANT"
- QUIT
- +4 SET DGSTAT=$PIECE(IB0,"^",13)
- IF $SELECT(DGSTAT=3:0,DGSTAT=4:0,1:1)
- SET IBAR("ERR")=$SELECT(DGSTAT=7:"BILL CANCELLED",1:"BILL STATUS INAPPROPRIATE")
- QUIT
- +5 ; S DFN=$P(IB0,"^",2),IBPNT=PRCASV("NOTICE"),IBAC=4 D ENP^IBCF1
- +6 ; replaced above line with following 2 lines 4/28/92 RLW
- +7 ;S DFN=$P(IB0,"^",2),IBAC=4 I $P(^DGCR(399,IBIFN,0),"^",19)>1 D EN2^IBCF G REPRNTQ
- +8 SET DFN=$PIECE(IB0,"^",2)
- SET IBAC=4
- IF $$FT^IBCU3(IBIFN)>1
- DO EN2^IBCF
- GOTO REPRNTQ
- +9 SET IBPNT=PRCASV("NOTICE")
- DO ENP^IBCF1
- +10 SET IBAR("OKAY")=1
- REPRNTQ KILL DFN,I,J
- +1 KILL M,X,X2,Y,Z,VADM,VAERR,DR,DA,D1,DGBS,DGCNT,IB,IBBILL,IBBNO,IBBT,IBC,IBCPT,IBEPAR,IBDPT,IBDT,IBF,IBIP,IBLS,IBO,IBPNT,DGSTAT,IBAC,IBIFN,IB0
- +2 KILL IBPTF,IBRATY,IBREV,IBREVC,IBST,IBTF,IBU,IBUTL,DGDA,DGLCNT,DGPAG,DGPT,DGRVC,DGRV,DGTOTPAG,DGTEXT,DGTEXT1,IBDI,IBDIN,IBBS,IBCC,IBPT,DGREVC,DGRSPAC,DGSM
- +3 QUIT
- +4 ;
- PRINT ;Entry for A/R to create option to print bills.
- +1 SET IBVIEW=1
- DO KILL^IBCMENU
- DO GEN^IBCB
- DO KILL^IBCMENU
- +2 QUIT
