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 Dec 13, 2024@02:27:10 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 ;
