IBCF13.m

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