IBOA32 ;ALB/CPM - PRINT ALL BILLS FOR A PATIENT (CON'T) ; 28-JAN-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
;MAP TO DGCRA32
;
; Print out IB Actions onto the list.
D:($Y>(IOSL-5)) HDR^IBOA31 Q:IBQUIT
N IBND,IBND1,X
S IBND=$G(^IB($E(IBIFN,1,$L(IBIFN)-1),0)),IBND1=$G(^(1))
W !,$S($P(IBND,"^",11)]"":$P($P(IBND,"^",11),"-",2),$P(IBND,"^",5)=99:"",$P(IBND,"^",5)=10:"",1:"Pending")
W ?8,$$DAT1^IBOUTL($S($P(IBND,"^",11)="":"",$P(IBND,"^",5)>2&($P(IBND,"^",5)'=99):$P(IBND1,"^",4)\1,1:""))
S X=$P($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")," ",2,99)
W ?18,$E($P(X," ",1,$L(X," ")-1),1,17)
W ?37,$S($P(IBND,"^",3)<7:"PHARMACY COPAY",$P(IBND1,"^",5):"CHAMPVA SUBSIST",1:"AUT MEANS TEST")
W ?54,$$DAT1^IBOUTL(-IBDT)
W ?64,$$DAT1^IBOUTL($S($P(IBND,"^",14):$P(IBND,"^",14),1:$P(IBND1,"^",2)\1))
W ?74,$$DAT1^IBOUTL($S($P(IBND,"^",15):$P(IBND,"^",15),1:$P(IBND1,"^",2)\1))
W ?89,"N/A",?94,$E($P($G(^IBE(350.21,+$P(IBND,"^",5),0)),"^",2),1,17)
Q
;
UTIL ; Gather all IB Actions for a patient.
N DATE,IBN,X,A,B,C,D,E
S IBN=0 F S IBN=$O(^IB("C",DFN,IBN)) Q:'IBN S X=$G(^IB(IBN,0)) D:X
. I 'IBIBRX,$E($G(^IBE(350.1,+$P(X,"^",3),0)),1,3)="PSO" Q
. Q:$P(X,"^",8)["ADMISSION"
. Q:'$D(^IB("APDT",IBN))
. S (C,D)="",C=$O(^IB("APDT",IBN,C)),D=$O(^IB("APDT",IBN,C,D))
. S E=$P($G(^IB(D,0)),U,3)
. S A=$P($G(^IBE(350.1,E,0)),U,5)
. S IBN=$S(A=2:$P($Q(^IB("APDT",IBN,C,D)),")",1),A=3:$P($Q(^IB("APDT",IBN,C,D)),")",1),1:IBN)
. I $P(IBN,",",4)>0 S IBN=$P(IBN,",",4)
. S DATE=$P($G(^IB(+$P(X,"^",16),0)),"^",17)
. S:'DATE DATE=$P($G(^IB(IBN,1)),"^",5)
. S:'DATE DATE=$P($G(^IB(IBN,1)),"^",2)\1
. S:DATE ^UTILITY($J,-DATE,IBN_"X")=""
Q
IBOA32 ;ALB/CPM - PRINT ALL BILLS FOR A PATIENT (CON'T) ; 28-JAN-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ;MAP TO DGCRA32
+4 ;
+5 ; Print out IB Actions onto the list.
+6 IF ($Y>(IOSL-5))
DO HDR^IBOA31
IF IBQUIT
QUIT
+7 NEW IBND,IBND1,X
+8 SET IBND=$GET(^IB($EXTRACT(IBIFN,1,$LENGTH(IBIFN)-1),0))
SET IBND1=$GET(^(1))
+9 WRITE !,$SELECT($PIECE(IBND,"^",11)]"":$PIECE($PIECE(IBND,"^",11),"-",2),$PIECE(IBND,"^",5)=99:"",$PIECE(IBND,"^",5)=10:"",1:"Pending")
+10 WRITE ?8,$$DAT1^IBOUTL($SELECT($PIECE(IBND,"^",11)="":"",$PIECE(IBND,"^",5)>2&($PIECE(IBND,"^",5)'=99):$PIECE(IBND1,"^",4)\1,1:""))
+11 SET X=$PIECE($PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^")," ",2,99)
+12 WRITE ?18,$EXTRACT($PIECE(X," ",1,$LENGTH(X," ")-1),1,17)
+13 WRITE ?37,$SELECT($PIECE(IBND,"^",3)<7:"PHARMACY COPAY",$PIECE(IBND1,"^",5):"CHAMPVA SUBSIST",1:"AUT MEANS TEST")
+14 WRITE ?54,$$DAT1^IBOUTL(-IBDT)
+15 WRITE ?64,$$DAT1^IBOUTL($SELECT($PIECE(IBND,"^",14):$PIECE(IBND,"^",14),1:$PIECE(IBND1,"^",2)\1))
+16 WRITE ?74,$$DAT1^IBOUTL($SELECT($PIECE(IBND,"^",15):$PIECE(IBND,"^",15),1:$PIECE(IBND1,"^",2)\1))
+17 WRITE ?89,"N/A",?94,$EXTRACT($PIECE($GET(^IBE(350.21,+$PIECE(IBND,"^",5),0)),"^",2),1,17)
+18 QUIT
+19 ;
UTIL ; Gather all IB Actions for a patient.
+1 NEW DATE,IBN,X,A,B,C,D,E
+2 SET IBN=0
FOR
SET IBN=$ORDER(^IB("C",DFN,IBN))
IF 'IBN
QUIT
SET X=$GET(^IB(IBN,0))
IF X
Begin DoDot:1
+3 IF 'IBIBRX
IF $EXTRACT($GET(^IBE(350.1,+$PIECE(X,"^",3),0)),1,3)="PSO"
QUIT
+4 IF $PIECE(X,"^",8)["ADMISSION"
QUIT
+5 IF '$DATA(^IB("APDT",IBN))
QUIT
+6 SET (C,D)=""
SET C=$ORDER(^IB("APDT",IBN,C))
SET D=$ORDER(^IB("APDT",IBN,C,D))
+7 SET E=$PIECE($GET(^IB(D,0)),U,3)
+8 SET A=$PIECE($GET(^IBE(350.1,E,0)),U,5)
+9 SET IBN=$SELECT(A=2:$PIECE($QUERY(^IB("APDT",IBN,C,D)),")",1),A=3:$PIECE($QUERY(^IB("APDT",IBN,C,D)),")",1),1:IBN)
+10 IF $PIECE(IBN,",",4)>0
SET IBN=$PIECE(IBN,",",4)
+11 SET DATE=$PIECE($GET(^IB(+$PIECE(X,"^",16),0)),"^",17)
+12 IF 'DATE
SET DATE=$PIECE($GET(^IB(IBN,1)),"^",5)
+13 IF 'DATE
SET DATE=$PIECE($GET(^IB(IBN,1)),"^",2)\1
+14 IF DATE
SET ^UTILITY($JOB,-DATE,IBN_"X")=""
End DoDot:1
+15 QUIT
