IBCF13 ;ALB/AAS - PRINT UB-82 FROM A ;8/2/90
;;2.0;INTEGRATED BILLING;**63,363**;21-MAR-94;Build 35
;;Per VHA Directive 2004-038, 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
N IBECME
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
; IB*2*363 next line was added to prevent the print of forms for ePharmacy bills
Q:$P($G(^DGCR(399,IBIFN,"M1")),"^",8)]"" ;ECME number exists so the bill was electronically submitted
; 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,EN5^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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCF13 1943 printed Oct 16, 2024@18:13:28 Page 2
IBCF13 ;ALB/AAS - PRINT UB-82 FROM A ;8/2/90
+1 ;;2.0;INTEGRATED BILLING;**63,363**;21-MAR-94;Build 35
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;MAP TO DGCRP3
+4 ;
+5 ;Entry point for AR to print 2nd and 3rd Notice UB-82's
+6 ;Device handling to be done by calling routine
+7 ;Requires input - PRCASV("ARREC") = internal number of bill
+8 ; - PRCASV("NOTICE")= number of notice
+9 ;ouputs - IBAR("ERR") = error message
+10 ; - IBAR("OKAY") = 1 normal finish, 0 not finished
+11 ;
REPRNT ;AR variables that need newing
NEW I,J,DFN
+1 NEW IBECME
+2 KILL IBAR("ERR")
+3 SET IBAR("OKAY")=0
IF '$DATA(PRCASV("ARREC"))!('$DATA(PRCASV("NOTICE")))
SET IBAR("ERR")="MISSING INPUT VARIABLES"
QUIT
+4 SET IBIFN=PRCASV("ARREC")
SET IB0=$SELECT($DATA(^DGCR(399,IBIFN,0)):^(0),1:"")
IF IB0=""
SET IBAR("ERR")="BILL NON-EXISTANT"
QUIT
+5 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
+6 ; IB*2*363 next line was added to prevent the print of forms for ePharmacy bills
+7 ;ECME number exists so the bill was electronically submitted
if $PIECE($GET(^DGCR(399,IBIFN,"M1")),"^",8)]""
QUIT
+8 ; S DFN=$P(IB0,"^",2),IBPNT=PRCASV("NOTICE"),IBAC=4 D ENP^IBCF1
+9 ; replaced above line with following 2 lines 4/28/92 RLW
+10 ;S DFN=$P(IB0,"^",2),IBAC=4 I $P(^DGCR(399,IBIFN,0),"^",19)>1 D EN2^IBCF G REPRNTQ
+11 SET DFN=$PIECE(IB0,"^",2)
SET IBAC=4
IF $$FT^IBCU3(IBIFN)>1
DO EN2^IBCF
DO EN5^IBCF
GOTO REPRNTQ
+12 SET IBPNT=PRCASV("NOTICE")
DO ENP^IBCF1
+13 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
