- IBTOBI4 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 27-OCT-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- CLIN ; -- output clinical information
- N IBOE,DGPM
- Q:$D(IBCTHDR)
- ;
- I $P(IBETYP,"^",3)=1 S DGPM=$P(^IBT(356,+IBTRN,0),"^",5) I 'DGPM Q
- I $P(IBETYP,"^",3)=2 S IBOE=$P(^IBT(356,+IBTRN,0),"^",4)
- F IBTAG="DIAG","PROC","PROV" D @IBTAG Q:IBQUIT
- Q
- ;
- DIAG ; -- print diagnosis information
- I '$G(DGPM),('$G(IBOE)) Q
- Q:$P(IBETYP,"^",3)>2
- I ($Y+9)>IOSL D HDR^IBTOBI Q:IBQUIT
- DIAG1 W !," Diagnosis Information "
- N IBXY,SDDXY
- I $G(DGPM) D SET^IBTRE3(+IBTRN) W:'$D(IBXY) !?6,"Nothing on File" D:$D(IBXY) LIST^IBTRE3(.IBXY)
- I $G(IBOE) D SET^SDCO4(IBOE) W:'$D(SDDXY) !?6,"Nothing on File" D:$D(SDDXY) LIST^SDCO4(.SDDXY)
- ;
- D:$G(DGPM) DRG
- W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),!
- Q
- ;
- PROC ; -- print procedure information
- Q:$P(IBETYP,"^",3)>2
- I ($Y+9)>IOSL D HDR^IBTOBI Q:IBQUIT
- PROC1 W !," Procedure Information "
- ;
- N IBXY,IBCNT S IBCNT=0
- I $G(DGPM) D SET^IBTRE4(+IBTRN) W:'$D(IBXY) !?6,"Nothing on File" D:$D(IBXY) LIST^IBTRE4(.IBXY)
- I '$G(DGPM) D W:'$D(IBXY) !?6,"Nothing on File" D:$D(IBXY) LIST(.IBXY)
- .S IBDT=$P($P(IBTRND,"^",6),"."),IBI=IBDT-.000001
- .F S IBI=$O(^SDV("C",DFN,IBI)) Q:'IBI!(IBI>(IBDT+.25)) D
- ..S IBCS=0 F S IBCS=$O(^SDV(IBI,"CS",IBCS)) Q:'IBCS I $D(^SDV(IBI,"CS",IBCS,"PR")) S IBPR=^("PR") D
- ...F IBJ=1:1:5 I $P(IBPR,"^",IBJ) S IBCNT=IBCNT+1,IBXY(IBCNT)=$P(IBPR,"^",IBJ)_"^"_IBI
- W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),!
- Q
- ;
- PROV ; -- print provider information
- I '$G(DGPM),('$G(IBOE)) Q
- Q:$P(IBETYP,"^",3)>2
- I ($Y+9)>IOSL D HDR^IBTOBI Q:IBQUIT
- PROV1 W !," Provider Information "
- N IBXY,SDPRY
- I $G(DGPM) D SET^IBTRE5(+IBTRN) W:'$D(IBXY) !?6,"Nothing on File" D:$D(IBXY) LIST^IBTRE5(.IBXY)
- I $G(IBOE) D SET^SDCO3(IBOE) W:'$D(SDPRY) !?6,"Nothing on File" D:$D(SDPRY) LIST^SDCO3(.SDPRY)
- W:'IBQUIT !?4,$TR($J(" ",IOM-8)," ","-"),!
- Q
- ;
- LIST(IBXY) ; -- list procedures array
- ; Input -- IBXY Diagnosis Array Subscripted by a Number
- ; Output -- List Diagnosis Array
- N I,IBXD
- W !
- S I=0 F S I=$O(IBXY(I)) Q:'I S IBXD=$G(^ICPT(+IBXY(I),0)) D
- .W !?2,I," ",$P(IBXD,"^"),?15,$E($P(IBXD,"^",2),1,40),?60,$$DAT1^IBOUTL($P(IBXY(I),"^",2),"2P")
- Q
- ;
- DRG ; -- print drgs.
- I '$G(DGPM) Q
- Q:$P(IBETYP,"^",3)>1
- I ($Y+9)>IOSL D HDR^IBTOBI Q:IBQUIT
- DRG1 W !!," Associated Interim DRG Information "
- N IBX,IBDTE,IBDRG
- I $G(DGPM) D
- .I '$O(^IBT(356.93,"AMVD",DGPM,0)) W !?6,"Nothing on File" Q
- .S IBDTE=0 F S IBDTE=$O(^IBT(356.93,"AMVD",DGPM,IBDTE)) Q:'IBDTE S IBDRG=0 F S IBDRG=$O(^IBT(356.93,"AMVD",DGPM,IBDTE,IBDRG)) Q:'IBDRG D
- ..S IBX=$G(^IBT(356.93,IBDRG,0)) Q:IBX=""
- ..W !?5,$$DAT1^IBOUTL($P(IBX,"^",3)),?16,+IBX," - ",$G(^ICD(+IBX,1,1,0))
- ..W !?21," Estimate ALOS: "_$J($P(IBX,"^",4),4,1)
- ..W ?45," Days Remaining: "_$J($P(IBX,"^",5),2)
- Q
- ;
- 4 ; -- Visit region for prosthetics
- N IBDA,IBRMPR S IBDA=$P(IBTRND,"^",9) D PRODATA^IBTUTL1(IBDA)
- S IBD(2,1)=" Item: "_$G(IBRMPR(660,+IBDA,4,"E"))
- S IBD(3,1)=" Description: "_$G(IBRMPR(660,+IBDA,24,"E"))
- S IBD(4,1)=" Quantity: "_$J($G(IBRMPR(660,+IBDA,5,"E")),4)
- S IBD(5,1)=" Total Cost: $"_$G(IBRMPR(660,+IBDA,14,"E"))
- S IBD(6,1)=" Transaction: "_$G(IBRMPR(660,+IBDA,2,"E"))
- S IBD(7,1)=" Vendor: "_$G(IBRMPR(660,+IBDA,7,"E"))
- S IBD(8,1)=" Source: "_$G(IBRMPR(660,+IBDA,12,"E"))
- S IBD(9,1)=" Delivery Date: "_$G(IBRMPR(660,+IBDA,10,"E"))
- S IBD(10,1)=" Remarks: "_$G(IBRMPR(660,+IBDA,16,"E"))
- S IBD(11,1)=" Return Status: "_$G(IBRMPR(660,+IBDA,17,"E"))
- Q
- IBTOBI4 ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ; 27-OCT-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- CLIN ; -- output clinical information
- +1 NEW IBOE,DGPM
- +2 IF $DATA(IBCTHDR)
- QUIT
- +3 ;
- +4 IF $PIECE(IBETYP,"^",3)=1
- SET DGPM=$PIECE(^IBT(356,+IBTRN,0),"^",5)
- IF 'DGPM
- QUIT
- +5 IF $PIECE(IBETYP,"^",3)=2
- SET IBOE=$PIECE(^IBT(356,+IBTRN,0),"^",4)
- +6 FOR IBTAG="DIAG","PROC","PROV"
- DO @IBTAG
- IF IBQUIT
- QUIT
- +7 QUIT
- +8 ;
- DIAG ; -- print diagnosis information
- +1 IF '$GET(DGPM)
- IF ('$GET(IBOE))
- QUIT
- +2 IF $PIECE(IBETYP,"^",3)>2
- QUIT
- +3 IF ($Y+9)>IOSL
- DO HDR^IBTOBI
- IF IBQUIT
- QUIT
- DIAG1 WRITE !," Diagnosis Information "
- +1 NEW IBXY,SDDXY
- +2 IF $GET(DGPM)
- DO SET^IBTRE3(+IBTRN)
- IF '$DATA(IBXY)
- WRITE !?6,"Nothing on File"
- IF $DATA(IBXY)
- DO LIST^IBTRE3(.IBXY)
- +3 IF $GET(IBOE)
- DO SET^SDCO4(IBOE)
- IF '$DATA(SDDXY)
- WRITE !?6,"Nothing on File"
- IF $DATA(SDDXY)
- DO LIST^SDCO4(.SDDXY)
- +4 ;
- +5 IF $GET(DGPM)
- DO DRG
- +6 IF 'IBQUIT
- WRITE !?4,$TRANSLATE($JUSTIFY(" ",IOM-8)," ","-"),!
- +7 QUIT
- +8 ;
- PROC ; -- print procedure information
- +1 IF $PIECE(IBETYP,"^",3)>2
- QUIT
- +2 IF ($Y+9)>IOSL
- DO HDR^IBTOBI
- IF IBQUIT
- QUIT
- PROC1 WRITE !," Procedure Information "
- +1 ;
- +2 NEW IBXY,IBCNT
- SET IBCNT=0
- +3 IF $GET(DGPM)
- DO SET^IBTRE4(+IBTRN)
- IF '$DATA(IBXY)
- WRITE !?6,"Nothing on File"
- IF $DATA(IBXY)
- DO LIST^IBTRE4(.IBXY)
- +4 IF '$GET(DGPM)
- Begin DoDot:1
- +5 SET IBDT=$PIECE($PIECE(IBTRND,"^",6),".")
- SET IBI=IBDT-.000001
- +6 FOR
- SET IBI=$ORDER(^SDV("C",DFN,IBI))
- IF 'IBI!(IBI>(IBDT+.25))
- QUIT
- Begin DoDot:2
- +7 SET IBCS=0
- FOR
- SET IBCS=$ORDER(^SDV(IBI,"CS",IBCS))
- IF 'IBCS
- QUIT
- IF $DATA(^SDV(IBI,"CS",IBCS,"PR"))
- SET IBPR=^("PR")
- Begin DoDot:3
- +8 FOR IBJ=1:1:5
- IF $PIECE(IBPR,"^",IBJ)
- SET IBCNT=IBCNT+1
- SET IBXY(IBCNT)=$PIECE(IBPR,"^",IBJ)_"^"_IBI
- End DoDot:3
- End DoDot:2
- End DoDot:1
- IF '$DATA(IBXY)
- WRITE !?6,"Nothing on File"
- IF $DATA(IBXY)
- DO LIST(.IBXY)
- +9 IF 'IBQUIT
- WRITE !?4,$TRANSLATE($JUSTIFY(" ",IOM-8)," ","-"),!
- +10 QUIT
- +11 ;
- PROV ; -- print provider information
- +1 IF '$GET(DGPM)
- IF ('$GET(IBOE))
- QUIT
- +2 IF $PIECE(IBETYP,"^",3)>2
- QUIT
- +3 IF ($Y+9)>IOSL
- DO HDR^IBTOBI
- IF IBQUIT
- QUIT
- PROV1 WRITE !," Provider Information "
- +1 NEW IBXY,SDPRY
- +2 IF $GET(DGPM)
- DO SET^IBTRE5(+IBTRN)
- IF '$DATA(IBXY)
- WRITE !?6,"Nothing on File"
- IF $DATA(IBXY)
- DO LIST^IBTRE5(.IBXY)
- +3 IF $GET(IBOE)
- DO SET^SDCO3(IBOE)
- IF '$DATA(SDPRY)
- WRITE !?6,"Nothing on File"
- IF $DATA(SDPRY)
- DO LIST^SDCO3(.SDPRY)
- +4 IF 'IBQUIT
- WRITE !?4,$TRANSLATE($JUSTIFY(" ",IOM-8)," ","-"),!
- +5 QUIT
- +6 ;
- LIST(IBXY) ; -- list procedures array
- +1 ; Input -- IBXY Diagnosis Array Subscripted by a Number
- +2 ; Output -- List Diagnosis Array
- +3 NEW I,IBXD
- +4 WRITE !
- +5 SET I=0
- FOR
- SET I=$ORDER(IBXY(I))
- IF 'I
- QUIT
- SET IBXD=$GET(^ICPT(+IBXY(I),0))
- Begin DoDot:1
- +6 WRITE !?2,I," ",$PIECE(IBXD,"^"),?15,$EXTRACT($PIECE(IBXD,"^",2),1,40),?60,$$DAT1^IBOUTL($PIECE(IBXY(I),"^",2),"2P")
- End DoDot:1
- +7 QUIT
- +8 ;
- DRG ; -- print drgs.
- +1 IF '$GET(DGPM)
- QUIT
- +2 IF $PIECE(IBETYP,"^",3)>1
- QUIT
- +3 IF ($Y+9)>IOSL
- DO HDR^IBTOBI
- IF IBQUIT
- QUIT
- DRG1 WRITE !!," Associated Interim DRG Information "
- +1 NEW IBX,IBDTE,IBDRG
- +2 IF $GET(DGPM)
- Begin DoDot:1
- +3 IF '$ORDER(^IBT(356.93,"AMVD",DGPM,0))
- WRITE !?6,"Nothing on File"
- QUIT
- +4 SET IBDTE=0
- FOR
- SET IBDTE=$ORDER(^IBT(356.93,"AMVD",DGPM,IBDTE))
- IF 'IBDTE
- QUIT
- SET IBDRG=0
- FOR
- SET IBDRG=$ORDER(^IBT(356.93,"AMVD",DGPM,IBDTE,IBDRG))
- IF 'IBDRG
- QUIT
- Begin DoDot:2
- +5 SET IBX=$GET(^IBT(356.93,IBDRG,0))
- IF IBX=""
- QUIT
- +6 WRITE !?5,$$DAT1^IBOUTL($PIECE(IBX,"^",3)),?16,+IBX," - ",$GET(^ICD(+IBX,1,1,0))
- +7 WRITE !?21," Estimate ALOS: "_$JUSTIFY($PIECE(IBX,"^",4),4,1)
- +8 WRITE ?45," Days Remaining: "_$JUSTIFY($PIECE(IBX,"^",5),2)
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- 4 ; -- Visit region for prosthetics
- +1 NEW IBDA,IBRMPR
- SET IBDA=$PIECE(IBTRND,"^",9)
- DO PRODATA^IBTUTL1(IBDA)
- +2 SET IBD(2,1)=" Item: "_$GET(IBRMPR(660,+IBDA,4,"E"))
- +3 SET IBD(3,1)=" Description: "_$GET(IBRMPR(660,+IBDA,24,"E"))
- +4 SET IBD(4,1)=" Quantity: "_$JUSTIFY($GET(IBRMPR(660,+IBDA,5,"E")),4)
- +5 SET IBD(5,1)=" Total Cost: $"_$GET(IBRMPR(660,+IBDA,14,"E"))
- +6 SET IBD(6,1)=" Transaction: "_$GET(IBRMPR(660,+IBDA,2,"E"))
- +7 SET IBD(7,1)=" Vendor: "_$GET(IBRMPR(660,+IBDA,7,"E"))
- +8 SET IBD(8,1)=" Source: "_$GET(IBRMPR(660,+IBDA,12,"E"))
- +9 SET IBD(9,1)=" Delivery Date: "_$GET(IBRMPR(660,+IBDA,10,"E"))
- +10 SET IBD(10,1)=" Remarks: "_$GET(IBRMPR(660,+IBDA,16,"E"))
- +11 SET IBD(11,1)=" Return Status: "_$GET(IBRMPR(660,+IBDA,17,"E"))
- +12 QUIT
