- IBTOBI ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ;27-OCT-93
- ;;2.0;INTEGRATED BILLING;**91,160,199,309,276,458**;21-MAR-94;Build 4
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- % I '$D(DT) D DT^DICRW
- W !!,"Bill Preparation Report for a Single Visit"
- D END
- ;
- PAT ; -- Select patient
- W !!
- S DIC="^DPT(",DIC(0)="AEQM"
- N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
- D ^DIC K DIC I +Y<1 G END
- S DFN=+Y
- ;
- VSIT ;
- ; -- get claims tracking visit entry
- D TRAC^IBTRV K IBY
- I '$G(IBTRN) G END
- ;
- DEV ; -- select device, run option
- W !
- S %ZIS="QM" D ^%ZIS G:POP END
- I $D(IO("Q")) S ZTRTN="DQ^IBTOBI",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB - Bill Preparation Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G PAT
- ;
- U IO
- D ONE,END G PAT
- Q
- DQ ; -- task man entry point
- D ONE
- ;
- END ; -- Clean up
- W !
- I $D(ZTQUEUED) S ZTREQ="@" Q
- D ^%ZISC
- K I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,DIRUT,DUOUT,IBCNT,IBI,IBJ,IBNAR,IBTNOD,IBTRCD1,IBTRTP,IBDA
- D KVAR^VADPT
- Q
- ONE ; -- print one billing report from ct
- S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
- D PID^VADPT
- S IBTRND=$G(^IBT(356,+IBTRN,0)),IBTRND1=$G(^(1))
- S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
- D HDR,SECT1,^IBTOBI1
- Q
- ;
- HDR ; -- Print header for billing report
- Q:IBQUIT
- I '$D(VA("PID")) N I,J D PID^VADPT
- I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
- I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
- S IBPAG=IBPAG+1
- W !,$S($D(IBCTHDR):IBCTHDR,1:"Bill Preparation Report"),?(IOM-33),"Page ",IBPAG," ",IBHDT
- W !!,$E($P($G(^DPT(DFN,0)),"^"),1,25),?28,VA("PID"),?50,"DOB: ",$$FMTE^XLFDT($P($G(^DPT(DFN,0)),"^",3),1)
- W !,$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))," on ",$$FMTE^XLFDT($P(IBTRND,"^",6),1)
- W !,$TR($J(" ",IOM)," ","-")
- Q
- ;
- SECT1 ; -- Section 1 - Visit info Region / misc billing info
- N IBD
- W !," Visit Information "
- S IBD(1,1)=" Visit Type: "_$P(IBETYP,"^")
- S X=$P(IBETYP,"^",3) I 'X W !,"No Visit Selected" Q
- D @X
- D MBI
- S I=0 F S I=$O(IBD(I)) Q:'I W !,$G(IBD(I,1)),?44,$E($G(IBD(I,2)),1,36)
- W !?4,$TR($J(" ",IOM-8)," ","-"),!
- Q
- 1 ; -- visit region for admission or scheduled admission
- S IBDISDT=""
- I $P($G(^DGPM(+$P(IBTRND,"^",5),0)),"^",17) S VAINDT=+$G(^DGPM(+$P(IBTRND,"^",5),0)),IBDISDT=+$G(^DGPM(+$P($G(^DGPM(+$P(IBTRND,"^",5),0)),"^",17),0))
- I '$D(VAIN) S VA200="" D INP^VADPT
- I VAIN(7)="" S Y=$P(IBTRND,"^",6) D D^DIQ S $P(VAIN(7),"^",2)=Y
- S IBD(2,1)="Admission Date: "_$P(VAIN(7),"^",2)
- S IBD(3,1)=" Ward: "_$P(VAIN(4),"^",2)
- S IBD(4,1)=" Specialty: "_$P(VAIN(3),"^",2)
- S IBD(5,1)="Discharge Date: "_$$FMTE^XLFDT(IBDISDT,1)
- Q
- 2 ; -- visit region for outpatient care
- N IBOE,IBOE0
- S IBOE=$P(IBTRND,"^",4),IBOE0=$$SCE^IBSDU(+IBOE)
- S IBD(2,1)=" Visit Date: "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
- I +IBOE<1 S IBD(3,1)=" No Outpatient Encounter Found" Q
- S IBD(3,1)=" Clinic: "_$P($G(^SC(+$P(IBOE0,U,4),0)),"^")
- S IBD(4,1)=" Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$P(IBOE0,U,12))
- S IBD(5,1)=" Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$P(IBOE0,U,10))
- S IBD(6,1)=" Special Cond: "_$$ENCL^IBTRED(IBOE)
- Q
- ;
- 3 ; -- visit region for rx refill
- N PSONTALK,PSOTMP,PSORXN,PSOFILL
- S PSONTALK=1 ;PSORXN=+$P(IBTRND,"^",8),PSOFILL=+$P(IBTRND,"^",10)
- S X=+$P(IBTRND,"^",8)_"^"_+$P(IBTRND,"^",10) D EN^PSOCPVW
- ;if refill was deleted and EN^PSOCPVW doesn't return any data use IB API
- I '$D(PSOTMP) D PSOCPVW^IBNCPDPC(+$P(IBTRND,"^",2),+$P(IBTRND,"^",8),.PSOTMP)
- S IBD(2,1)="Prescription #: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),.01,"E"))
- I $P(IBTRND,"^",10)=0 S IBD(3,1)=" Fill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6))
- I +$P(IBTRND,"^",10) S IBD(3,1)=" Refill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6))
- S IBD(4,1)=" Drug: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),6,"E"))
- S IBD(5,1)=" Quantity: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),7,"E")),8)
- S IBD(6,1)=" Days Supply: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),8,"E")),8)
- S IBD(7,1)=" NDC#: "_$$GETNDC^PSONDCUT(+$P(IBTRND,"^",8),$P(IBTRND,"^",10))
- S IBD(8,1)=" Physician: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),4,"E"))
- Q
- ;
- 4 ; -- Visit region for prosthetics
- D 4^IBTOBI4
- Q
- ;
- MBI ; -- Misc. billing info
- S IBD(1,2)=" Visit Billable: "_$S('$P(IBTRND,"^",19):"YES",1:"NO-"_$$EXPAND^IBTRE(356,.19,$P(IBTRND,"^",19)))
- S IBD(2,2)=" Second Opinion: "_$S('$P(IBTRND,"^",14):"NOT REQUIRED",1:$S('$P(IBTRND,"^",15):"REQUIRED-NOT OBTAINED",1:"OBTAINED"))
- S IBD(3,2)=" Auto Bill Date: "_$$FMTE^XLFDT($P(IBTRND,"^",17),1)
- S IBD(4,2)="Special Consent: ROI "_$S('$P(IBTRND,"^",31):"NOT DETERMINED",1:$$ROIEVT^IBTRR1(IBTRN))
- S IBD(5,2)="Special Billing: "_$$EXPAND^IBTRE(356,.12,$P(IBTRND,"^",12))
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOBI 4820 printed Jan 18, 2025@03:28:21 Page 2
- IBTOBI ;ALB/AAS - CLAIMS TRACKING BILLING INFORMATION PRINT ;27-OCT-93
- +1 ;;2.0;INTEGRATED BILLING;**91,160,199,309,276,458**;21-MAR-94;Build 4
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- % IF '$DATA(DT)
- DO DT^DICRW
- +1 WRITE !!,"Bill Preparation Report for a Single Visit"
- +2 DO END
- +3 ;
- PAT ; -- Select patient
- +1 WRITE !!
- +2 SET DIC="^DPT("
- SET DIC(0)="AEQM"
- +3 ;Suppress PATIENT file fuzzy lookups
- NEW DPTNOFZY
- SET DPTNOFZY=1
- +4 DO ^DIC
- KILL DIC
- IF +Y<1
- GOTO END
- +5 SET DFN=+Y
- +6 ;
- VSIT ;
- +1 ; -- get claims tracking visit entry
- +2 DO TRAC^IBTRV
- KILL IBY
- +3 IF '$GET(IBTRN)
- GOTO END
- +4 ;
- DEV ; -- select device, run option
- +1 WRITE !
- +2 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO END
- +3 IF $DATA(IO("Q"))
- SET ZTRTN="DQ^IBTOBI"
- SET ZTSAVE("IB*")=""
- SET ZTSAVE("DFN")=""
- SET ZTDESC="IB - Bill Preparation Report"
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- DO HOME^%ZIS
- GOTO PAT
- +4 ;
- +5 USE IO
- +6 DO ONE
- DO END
- GOTO PAT
- +7 QUIT
- DQ ; -- task man entry point
- +1 DO ONE
- +2 ;
- END ; -- Clean up
- +1 WRITE !
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +3 DO ^%ZISC
- +4 KILL I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,DIRUT,DUOUT,IBCNT,IBI,IBJ,IBNAR,IBTNOD,IBTRCD1,IBTRTP,IBDA
- +5 DO KVAR^VADPT
- +6 QUIT
- ONE ; -- print one billing report from ct
- +1 SET IBPAG=0
- SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
- SET IBQUIT=0
- +2 DO PID^VADPT
- +3 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
- SET IBTRND1=$GET(^(1))
- +4 SET IBETYP=$GET(^IBE(356.6,+$PIECE(IBTRND,"^",18),0))
- +5 DO HDR
- DO SECT1
- DO ^IBTOBI1
- +6 QUIT
- +7 ;
- HDR ; -- Print header for billing report
- +1 if IBQUIT
- QUIT
- +2 IF '$DATA(VA("PID"))
- NEW I,J
- DO PID^VADPT
- +3 IF $EXTRACT(IOST,1,2)="C-"
- IF IBPAG
- DO PAUSE^VALM1
- IF $DATA(DIRUT)
- SET IBQUIT=1
- QUIT
- +4 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
- WRITE @IOF
- +5 SET IBPAG=IBPAG+1
- +6 WRITE !,$SELECT($DATA(IBCTHDR):IBCTHDR,1:"Bill Preparation Report"),?(IOM-33),"Page ",IBPAG," ",IBHDT
- +7 WRITE !!,$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^"),1,25),?28,VA("PID"),?50,"DOB: ",$$FMTE^XLFDT($PIECE($GET(^DPT(DFN,0)),"^",3),1)
- +8 WRITE !,$$EXPAND^IBTRE(356,.18,$PIECE(IBTRND,"^",18))," on ",$$FMTE^XLFDT($PIECE(IBTRND,"^",6),1)
- +9 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
- +10 QUIT
- +11 ;
- SECT1 ; -- Section 1 - Visit info Region / misc billing info
- +1 NEW IBD
- +2 WRITE !," Visit Information "
- +3 SET IBD(1,1)=" Visit Type: "_$PIECE(IBETYP,"^")
- +4 SET X=$PIECE(IBETYP,"^",3)
- IF 'X
- WRITE !,"No Visit Selected"
- QUIT
- +5 DO @X
- +6 DO MBI
- +7 SET I=0
- FOR
- SET I=$ORDER(IBD(I))
- if 'I
- QUIT
- WRITE !,$GET(IBD(I,1)),?44,$EXTRACT($GET(IBD(I,2)),1,36)
- +8 WRITE !?4,$TRANSLATE($JUSTIFY(" ",IOM-8)," ","-"),!
- +9 QUIT
- 1 ; -- visit region for admission or scheduled admission
- +1 SET IBDISDT=""
- +2 IF $PIECE($GET(^DGPM(+$PIECE(IBTRND,"^",5),0)),"^",17)
- SET VAINDT=+$GET(^DGPM(+$PIECE(IBTRND,"^",5),0))
- SET IBDISDT=+$GET(^DGPM(+$PIECE($GET(^DGPM(+$PIECE(IBTRND,"^",5),0)),"^",17),0))
- +3 IF '$DATA(VAIN)
- SET VA200=""
- DO INP^VADPT
- +4 IF VAIN(7)=""
- SET Y=$PIECE(IBTRND,"^",6)
- DO D^DIQ
- SET $PIECE(VAIN(7),"^",2)=Y
- +5 SET IBD(2,1)="Admission Date: "_$PIECE(VAIN(7),"^",2)
- +6 SET IBD(3,1)=" Ward: "_$PIECE(VAIN(4),"^",2)
- +7 SET IBD(4,1)=" Specialty: "_$PIECE(VAIN(3),"^",2)
- +8 SET IBD(5,1)="Discharge Date: "_$$FMTE^XLFDT(IBDISDT,1)
- +9 QUIT
- 2 ; -- visit region for outpatient care
- +1 NEW IBOE,IBOE0
- +2 SET IBOE=$PIECE(IBTRND,"^",4)
- SET IBOE0=$$SCE^IBSDU(+IBOE)
- +3 SET IBD(2,1)=" Visit Date: "_$$DAT1^IBOUTL($PIECE(IBTRND,"^",6),"2P")
- +4 IF +IBOE<1
- SET IBD(3,1)=" No Outpatient Encounter Found"
- QUIT
- +5 SET IBD(3,1)=" Clinic: "_$PIECE($GET(^SC(+$PIECE(IBOE0,U,4),0)),"^")
- +6 SET IBD(4,1)=" Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$PIECE(IBOE0,U,12))
- +7 SET IBD(5,1)=" Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$PIECE(IBOE0,U,10))
- +8 SET IBD(6,1)=" Special Cond: "_$$ENCL^IBTRED(IBOE)
- +9 QUIT
- +10 ;
- 3 ; -- visit region for rx refill
- +1 NEW PSONTALK,PSOTMP,PSORXN,PSOFILL
- +2 ;PSORXN=+$P(IBTRND,"^",8),PSOFILL=+$P(IBTRND,"^",10)
- SET PSONTALK=1
- +3 SET X=+$PIECE(IBTRND,"^",8)_"^"_+$PIECE(IBTRND,"^",10)
- DO EN^PSOCPVW
- +4 ;if refill was deleted and EN^PSOCPVW doesn't return any data use IB API
- +5 IF '$DATA(PSOTMP)
- DO PSOCPVW^IBNCPDPC(+$PIECE(IBTRND,"^",2),+$PIECE(IBTRND,"^",8),.PSOTMP)
- +6 SET IBD(2,1)="Prescription #: "_$GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),.01,"E"))
- +7 IF $PIECE(IBTRND,"^",10)=0
- SET IBD(3,1)=" Fill Date: "_$$FMTE^XLFDT(+$PIECE(IBTRND,"^",6))
- +8 IF +$PIECE(IBTRND,"^",10)
- SET IBD(3,1)=" Refill Date: "_$$FMTE^XLFDT(+$PIECE(IBTRND,"^",6))
- +9 SET IBD(4,1)=" Drug: "_$GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),6,"E"))
- +10 SET IBD(5,1)=" Quantity: "_$JUSTIFY($GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),7,"E")),8)
- +11 SET IBD(6,1)=" Days Supply: "_$JUSTIFY($GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),8,"E")),8)
- +12 SET IBD(7,1)=" NDC#: "_$$GETNDC^PSONDCUT(+$PIECE(IBTRND,"^",8),$PIECE(IBTRND,"^",10))
- +13 SET IBD(8,1)=" Physician: "_$GET(PSOTMP(52,+$PIECE(IBTRND,"^",8),4,"E"))
- +14 QUIT
- +15 ;
- 4 ; -- Visit region for prosthetics
- +1 DO 4^IBTOBI4
- +2 QUIT
- +3 ;
- MBI ; -- Misc. billing info
- +1 SET IBD(1,2)=" Visit Billable: "_$SELECT('$PIECE(IBTRND,"^",19):"YES",1:"NO-"_$$EXPAND^IBTRE(356,.19,$PIECE(IBTRND,"^",19)))
- +2 SET IBD(2,2)=" Second Opinion: "_$SELECT('$PIECE(IBTRND,"^",14):"NOT REQUIRED",1:$SELECT('$PIECE(IBTRND,"^",15):"REQUIRED-NOT OBTAINED",1:"OBTAINED"))
- +3 SET IBD(3,2)=" Auto Bill Date: "_$$FMTE^XLFDT($PIECE(IBTRND,"^",17),1)
- +4 SET IBD(4,2)="Special Consent: ROI "_$SELECT('$PIECE(IBTRND,"^",31):"NOT DETERMINED",1:$$ROIEVT^IBTRR1(IBTRN))
- +5 SET IBD(5,2)="Special Billing: "_$$EXPAND^IBTRE(356,.12,$PIECE(IBTRND,"^",12))
- +6 QUIT
- +7 ;