| 1 | IBOA32 ;ALB/CPM - PRINT ALL BILLS FOR A PATIENT (CON'T) ; 28-JAN-92
|
|---|
| 2 | ;;2.0; INTEGRATED BILLING ;**7,95,347**; 21-MAR-94;Build 24
|
|---|
| 3 | ;
|
|---|
| 4 | ;MAP TO DGCRA32
|
|---|
| 5 | ;
|
|---|
| 6 | ; Print out IB Actions onto the list.
|
|---|
| 7 | D:($Y>(IOSL-5)) HDR^IBOA31 Q:IBQUIT
|
|---|
| 8 | N IBND,IBND1,X,IBX,IENS,IBRXN,IBRX,IBRF,IBRDT
|
|---|
| 9 | S IBND=$G(^IB($E(IBIFN,1,$L(IBIFN)-1),0)),IBND1=$G(^(1))
|
|---|
| 10 | S (IBRXN,IBRX,IBRF,IBRDT,IBX)=0
|
|---|
| 11 | I $P(IBND,"^",4)["52:" S IBRXN=$P($P(IBND,"^",4),":",2),IBRX=$P($P(IBND,"^",8),"-"),IBRF=$P($P(IBND,"^",4),":",3)
|
|---|
| 12 | I IBRF>0 S IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,.01)
|
|---|
| 13 | E S IBRDT=$$FILE^IBRXUTL(+IBRXN,22),IBX=$$APPT^IBCU3(IBRDT,DFN)
|
|---|
| 14 | W !,$S($P(IBND,"^",11)]"":$P($P(IBND,"^",11),"-",2),$P(IBND,"^",5)=99:"",$P(IBND,"^",5)=10:"",1:"Pending")
|
|---|
| 15 | W ?8,$$DAT1^IBOUTL($S($P(IBND,"^",11)="":"",$P(IBND,"^",5)>2&($P(IBND,"^",5)'=99):$P(IBND1,"^",4)\1,1:""))
|
|---|
| 16 | S X=$P($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")," ",2,99)
|
|---|
| 17 | W ?18,$E($P(X," ",1,$L(X," ")-1),1,17)
|
|---|
| 18 | W ?37,$S($P(IBND,"^",4)["350:":$E($P(IBND,"^",8),1,14),$P(IBND,"^",3)<7:"Rx:"_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),$P(IBND1,"^",5):"CHAMPVA SUBSIST",1:"AUT MEANS TEST")
|
|---|
| 19 | W:IBX=1 ?53,"*"
|
|---|
| 20 | W ?54,$$DAT1^IBOUTL(-IBDT)
|
|---|
| 21 | W ?64,$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,$P(IBND,"^",14):$P(IBND,"^",14),1:$P(IBND1,"^",2)\1))
|
|---|
| 22 | W ?74,$$DAT1^IBOUTL($S($P(IBND,"^",15):$P(IBND,"^",15),1:$P(IBND1,"^",2)\1))
|
|---|
| 23 | W ?89,"N/A",?94,$E($P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",2),1,17)
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | UTIL ; Gather all IB Actions for a patient.
|
|---|
| 27 | N DATE,IBN,X,A,B,C,D,E,IBNX
|
|---|
| 28 | S IBN=0 F S IBN=$O(^IB("C",DFN,IBN)) Q:'IBN S X=$G(^IB(IBN,0)) D:X
|
|---|
| 29 | . I 'IBIBRX,$E($G(^IBE(350.1,+$P(X,"^",3),0)),1,3)="PSO" Q
|
|---|
| 30 | . Q:$P(X,"^",8)["ADMISSION"
|
|---|
| 31 | . Q:'$D(^IB("APDT",IBN))
|
|---|
| 32 | . S (C,D)="",C=$O(^IB("APDT",IBN,C)),D=$O(^IB("APDT",IBN,C,D))
|
|---|
| 33 | . S E=$P($G(^IB(D,0)),U,3)
|
|---|
| 34 | . S A=$P($G(^IBE(350.1,E,0)),U,5)
|
|---|
| 35 | . S IBNX=$S(A=2:$P($Q(^IB("APDT",IBN,C,D)),")",1),A=3:$P($Q(^IB("APDT",IBN,C,D)),")",1),1:IBN)
|
|---|
| 36 | . I (A=2)!(A=3) D
|
|---|
| 37 | .. I IBNX["[""" S IBNX="^"_$P(IBNX,"]",2)
|
|---|
| 38 | . I $P(IBNX,",",4)>0 S IBNX=$P(IBNX,",",4)
|
|---|
| 39 | . S DATE=$P($G(^IB(+$P(X,"^",16),0)),"^",17)
|
|---|
| 40 | . S:'DATE DATE=$P($G(^IB(IBNX,1)),"^",5)
|
|---|
| 41 | . S:'DATE DATE=$P($G(^IB(IBNX,1)),"^",2)\1
|
|---|
| 42 | . S:DATE ^UTILITY($J,-DATE,IBNX_"X")=""
|
|---|
| 43 | Q
|
|---|
