source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOA32.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1IBOA32 ;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 ;
26UTIL ; 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
Note: See TracBrowser for help on using the repository browser.