- 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
