| [613] | 1 | IBCF11 ;ALB/MJB - PRINT UB-82 BILL (CONT.) ;25 JAN 89 12:54
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**133,210**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRP1
|
|---|
| 6 | ;
|
|---|
| 7 | Q
|
|---|
| 8 | 13 ;I $D(IBIP),$D(IBPR) W !!,$S($P(IB(0),"^",9)]"":$P(IB(0),"^",9),1:9)
|
|---|
| 9 | W !!,$P(IB(0),"^",9)
|
|---|
| 10 | ;I '$D(IBCPT),'$D(IBICD),'$D(IBHC) G 14
|
|---|
| 11 | ;G:$D(IBCPT) CPT G:$D(IBICD) ICD G:$D(IBHC) HCFA
|
|---|
| 12 | CPT ;W !!,"4"
|
|---|
| 13 | ;S I=0 F Z=1:1 S I=$O(IBCPT(I)) Q:'I S X=$S($D(IB("C")):$E($P(IB("C"),U,(I+10)),4,7),1:"") S IBCPTN=$P(^ICPT(IBCPT(I),0),"^") W:Z=1 ?3,$P(^(0),"^",2),?43,IBCPTN,?49,X W:Z=2 ?54,IBCPTN,?60,X W:Z=3 ?65,IBCPTN,?71,X
|
|---|
| 14 | ;G 14
|
|---|
| 15 | ICD ;W !!,"9"
|
|---|
| 16 | ;F I=4:1:6 I $D(IBICD(I)) S X=$E($P(IB("C"),U,(I+7)),4,5)_$E($P(IB("C"),U,(I+7)),6,7),Y=$S($D(^ICD0(IBICD(I),0)):^(0),1:"") W:I=4 ?3,$P(^ICD0(IBICD(I),0),U,4),?43,$P(Y,U,1),?49,X W:I=5 ?54,$P(Y,U,1),?60,X W:I=6 ?65,$P(Y,U,1),?71,X
|
|---|
| 17 | ;G 14
|
|---|
| 18 | HCFA ;W !!,"5"
|
|---|
| 19 | ;F I=7:1:9 I $D(IBHC(I)) S X=$E($P(IB("C"),U,(I+4)),4,5)_$E($P(IB("C"),U,(I+4)),6,7) W:I=7 ?3,$P(^ICPT(IBHC(I),0),"^",2),?43,IBHCN(I),?49,X W:I=8 ?54,IBHCN(I),?60,X W:I=9 ?65,IBHCN(I),?71,X
|
|---|
| 20 | D PROC
|
|---|
| 21 | 14 F I=1:1 Q:$Y>55 W !
|
|---|
| 22 | W ! W:$P(IB("U"),U,13)]"" ?22,$P(IB("U"),U,13) W ?33,$S($P(IB("U1"),U,13)="":"Dept. Veterans Affairs",1:$P(IB("U1"),U,13)),?56,$P(IB("U1"),U,14)
|
|---|
| 23 | S IBRATY=$P(^DGCR(399,IBIFN,0),U,7),IBRATY=$P(^DGCR(399.3,IBRATY,0),U,2)
|
|---|
| 24 | 15 W !!,"Patient ID: ",$P(VADM(2),"^"),!,"Bill Type: ",$S(IBRATY]"":IBRATY,1:"UNSPECIFIED")
|
|---|
| 25 | I $D(IBEPAR(1)),$P(IBEPAR(1),U,4)'="" W !,$P(IBEPAR(1),U,4)
|
|---|
| 26 | I IB("U1")]"",$P(IB("U1"),"^",8)]"" W !,"**",$P(IB("U1"),"^",8),"**"
|
|---|
| 27 | 16 F I=1:1 Q:$Y>61 W !
|
|---|
| 28 | I $D(IBEPAR(1)),$P(IBEPAR(1),U,1)'="" W ?46,$P(IBEPAR(1),U,1) W:$P(IBEPAR(1),U,2)'="" !,?46,$P(IBEPAR(1),U,2)
|
|---|
| 29 | S IBXDT=$S(IBPNT:DT,$P(IB("S"),U,12)]"":$P(IB("S"),U,12),1:DT) W ?69,$E(IBXDT,4,5)_"-"_$E(IBXDT,6,7)_"-"_$E(IBXDT,2,3)
|
|---|
| 30 | W ! S (DIC,DIE)=399,IBYY=$S($P(^DGCR(399,IBIFN,"S"),"^",12)="":"@92",1:"@94"),DA=IBIFN,DR="[IB STATUS]" D ^DIE K DIC,DIE,IBYY
|
|---|
| 31 | D BSTAT^IBCDC(IBIFN) ; remove from auto biller list
|
|---|
| 32 | K IBXDT,IBMA
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | PROC ; -print first 3-5 procedure codes
|
|---|
| 36 | S TAB=43
|
|---|
| 37 | S J=0 F I=1:1 S J=$O(IBPROC(J)) Q:'J!(I>3) D
|
|---|
| 38 | . I IBPROC(J)["ICD" S X=$$ICD0^IBACSV(+IBPROC(J),+$P(IBPROC(J),U,2))
|
|---|
| 39 | . I IBPROC(J)["ICPT" S X=$$CPT^IBACSV(+IBPROC(J),+$P(IBPROC(J),U,2))
|
|---|
| 40 | . S Y=$E($P(IBPROC(J),U,2),4,7)
|
|---|
| 41 | . ;
|
|---|
| 42 | . I I=1 W ?3,$E($P(X,U,$S(IBPROC(J)["ICD":4,1:2)),1,30)
|
|---|
| 43 | . W ?(TAB+(I-1*11)),$P(X,U),?(TAB+6+(I-1*11)),Y
|
|---|
| 44 | Q
|
|---|
| 45 | ;IBCF11
|
|---|
