Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBTOBI

IBTOBI.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. % I '$D(DT) D DT^DICRW
  1. W !!,"Bill Preparation Report for a Single Visit"
  1. D END
  1. ;
  1. PAT ; -- Select patient
  1. W !!
  1. S DIC="^DPT(",DIC(0)="AEQM"
  1. N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
  1. D ^DIC K DIC I +Y<1 G END
  1. S DFN=+Y
  1. ;
  1. VSIT ;
  1. ; -- get claims tracking visit entry
  1. D TRAC^IBTRV K IBY
  1. I '$G(IBTRN) G END
  1. ;
  1. DEV ; -- select device, run option
  1. W !
  1. S %ZIS="QM" D ^%ZIS G:POP END
  1. 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
  1. ;
  1. U IO
  1. D ONE,END G PAT
  1. Q
  1. DQ ; -- task man entry point
  1. D ONE
  1. ;
  1. END ; -- Clean up
  1. W !
  1. I $D(ZTQUEUED) S ZTREQ="@" Q
  1. D ^%ZISC
  1. 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
  1. D KVAR^VADPT
  1. Q
  1. ONE ; -- print one billing report from ct
  1. S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
  1. D PID^VADPT
  1. S IBTRND=$G(^IBT(356,+IBTRN,0)),IBTRND1=$G(^(1))
  1. S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
  1. D HDR,SECT1,^IBTOBI1
  1. Q
  1. ;
  1. HDR ; -- Print header for billing report
  1. Q:IBQUIT
  1. I '$D(VA("PID")) N I,J D PID^VADPT
  1. I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
  1. I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
  1. S IBPAG=IBPAG+1
  1. W !,$S($D(IBCTHDR):IBCTHDR,1:"Bill Preparation Report"),?(IOM-33),"Page ",IBPAG," ",IBHDT
  1. W !!,$E($P($G(^DPT(DFN,0)),"^"),1,25),?28,VA("PID"),?50,"DOB: ",$$FMTE^XLFDT($P($G(^DPT(DFN,0)),"^",3),1)
  1. W !,$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))," on ",$$FMTE^XLFDT($P(IBTRND,"^",6),1)
  1. W !,$TR($J(" ",IOM)," ","-")
  1. Q
  1. ;
  1. SECT1 ; -- Section 1 - Visit info Region / misc billing info
  1. N IBD
  1. W !," Visit Information "
  1. S IBD(1,1)=" Visit Type: "_$P(IBETYP,"^")
  1. S X=$P(IBETYP,"^",3) I 'X W !,"No Visit Selected" Q
  1. D @X
  1. D MBI
  1. S I=0 F S I=$O(IBD(I)) Q:'I W !,$G(IBD(I,1)),?44,$E($G(IBD(I,2)),1,36)
  1. W !?4,$TR($J(" ",IOM-8)," ","-"),!
  1. Q
  1. 1 ; -- visit region for admission or scheduled admission
  1. S IBDISDT=""
  1. 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))
  1. I '$D(VAIN) S VA200="" D INP^VADPT
  1. I VAIN(7)="" S Y=$P(IBTRND,"^",6) D D^DIQ S $P(VAIN(7),"^",2)=Y
  1. S IBD(2,1)="Admission Date: "_$P(VAIN(7),"^",2)
  1. S IBD(3,1)=" Ward: "_$P(VAIN(4),"^",2)
  1. S IBD(4,1)=" Specialty: "_$P(VAIN(3),"^",2)
  1. S IBD(5,1)="Discharge Date: "_$$FMTE^XLFDT(IBDISDT,1)
  1. Q
  1. 2 ; -- visit region for outpatient care
  1. N IBOE,IBOE0
  1. S IBOE=$P(IBTRND,"^",4),IBOE0=$$SCE^IBSDU(+IBOE)
  1. S IBD(2,1)=" Visit Date: "_$$DAT1^IBOUTL($P(IBTRND,"^",6),"2P")
  1. I +IBOE<1 S IBD(3,1)=" No Outpatient Encounter Found" Q
  1. S IBD(3,1)=" Clinic: "_$P($G(^SC(+$P(IBOE0,U,4),0)),"^")
  1. S IBD(4,1)=" Appt. Status: "_$$EXPAND^IBTRE(409.68,.12,$P(IBOE0,U,12))
  1. S IBD(5,1)=" Appt. Type: "_$$EXPAND^IBTRE(409.68,.1,$P(IBOE0,U,10))
  1. S IBD(6,1)=" Special Cond: "_$$ENCL^IBTRED(IBOE)
  1. Q
  1. ;
  1. 3 ; -- visit region for rx refill
  1. N PSONTALK,PSOTMP,PSORXN,PSOFILL
  1. S PSONTALK=1 ;PSORXN=+$P(IBTRND,"^",8),PSOFILL=+$P(IBTRND,"^",10)
  1. S X=+$P(IBTRND,"^",8)_"^"_+$P(IBTRND,"^",10) D EN^PSOCPVW
  1. ;if refill was deleted and EN^PSOCPVW doesn't return any data use IB API
  1. I '$D(PSOTMP) D PSOCPVW^IBNCPDPC(+$P(IBTRND,"^",2),+$P(IBTRND,"^",8),.PSOTMP)
  1. S IBD(2,1)="Prescription #: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),.01,"E"))
  1. I $P(IBTRND,"^",10)=0 S IBD(3,1)=" Fill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6))
  1. I +$P(IBTRND,"^",10) S IBD(3,1)=" Refill Date: "_$$FMTE^XLFDT(+$P(IBTRND,"^",6))
  1. S IBD(4,1)=" Drug: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),6,"E"))
  1. S IBD(5,1)=" Quantity: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),7,"E")),8)
  1. S IBD(6,1)=" Days Supply: "_$J($G(PSOTMP(52,+$P(IBTRND,"^",8),8,"E")),8)
  1. S IBD(7,1)=" NDC#: "_$$GETNDC^PSONDCUT(+$P(IBTRND,"^",8),$P(IBTRND,"^",10))
  1. S IBD(8,1)=" Physician: "_$G(PSOTMP(52,+$P(IBTRND,"^",8),4,"E"))
  1. Q
  1. ;
  1. 4 ; -- Visit region for prosthetics
  1. D 4^IBTOBI4
  1. Q
  1. ;
  1. MBI ; -- Misc. billing info
  1. S IBD(1,2)=" Visit Billable: "_$S('$P(IBTRND,"^",19):"YES",1:"NO-"_$$EXPAND^IBTRE(356,.19,$P(IBTRND,"^",19)))
  1. S IBD(2,2)=" Second Opinion: "_$S('$P(IBTRND,"^",14):"NOT REQUIRED",1:$S('$P(IBTRND,"^",15):"REQUIRED-NOT OBTAINED",1:"OBTAINED"))
  1. S IBD(3,2)=" Auto Bill Date: "_$$FMTE^XLFDT($P(IBTRND,"^",17),1)
  1. S IBD(4,2)="Special Consent: ROI "_$S('$P(IBTRND,"^",31):"NOT DETERMINED",1:$$ROIEVT^IBTRR1(IBTRN))
  1. S IBD(5,2)="Special Billing: "_$$EXPAND^IBTRE(356,.12,$P(IBTRND,"^",12))
  1. Q
  1. ;