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

IBTRED0.m

Go to the documentation of this file.
  1. IBTRED0 ;ALB/AAS - EXPAND/EDIT CLAIMS TRACKING ENTRY - CONT. ;01-JUL-1993
  1. ;;2.0;INTEGRATED BILLING;**160,210,317,276,458,461,598**;21-MAR-94;Build 28
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. % I '$G(IBTRN)!($G(IORVON)="") G ^IBTRED
  1. D CLIN,BILL,PRE
  1. Q
  1. ;
  1. CLIN ; -- clinical data region
  1. N OFFSET,START,IBICD
  1. ;S START=7,OFFSET=2 *598 comment out
  1. S START=8,OFFSET=2
  1. ;
  1. CLIN1 N IBETYP S IBETYP=$$TRTP^IBTRE1(IBTRN) I 'IBETYP!(IBETYP>2) Q
  1. D SET^IBCNSP(START,OFFSET," Clinical Information ",IORVON,IORVOFF)
  1. I "12"[IBETYP D @IBETYP
  1. Q
  1. ;
  1. 1 ; -- inpatient clinical data
  1. ;D SET^IBCNSP(START+1,OFFSET," Provider: "_$E($P($G(VAIN(2)),"^",2),1,15))
  1. D SET^IBCNSP(START+1,OFFSET," Provider: "_$E($$APROV^IBTRE6(IBTRN),1,15))
  1. D SET^IBCNSP(START+2,OFFSET,"Admitting Diag: "_$E($$ADMDIAG^IBTRE6(IBTRN),1,23))
  1. D SET^IBCNSP(START+3,OFFSET," Primary Diag: "_$E($$PDIAG^IBTRE6(IBTRN),1,23))
  1. D LISTP^IBTRE6(IBTRN,.IBICD)
  1. D SET^IBCNSP(START+4,OFFSET," 1st Procedure: "_$E($$PROC^IBTRE6(+$G(IBICD(1)),1),1,23))
  1. D SET^IBCNSP(START+5,OFFSET," 2nd Procedure: "_$E($$PROC^IBTRE6(+$G(IBICD(2)),1),1,23))
  1. Q
  1. ;
  1. 2 ; -- outpatient clinic data
  1. N IBDATE ; Date of service for CSV
  1. S IBDATE=$$TRNDATE^IBACSV(IBTRN)
  1. S IBOE=$P(IBTRND,"^",4)
  1. I +IBOE<1 D SET^IBCNSP(START+1,OFFSET," No Outpatient Encounter Found") Q
  1. N IBSDV,IBSDX D SETSDV^IBTRE6(+IBOE,.IBSDV) S IBPCNT=IBSDV D SETSDX^IBTRE6(+IBOE,.IBSDX) S IBDCNT=IBSDX
  1. D SET^IBCNSP(START+1,OFFSET," Provider: "_$E($P($G(^VA(200,+$P($G(IBSDV(1)),"^",2),0)),"^"),1,23)) ;sdd(409.44
  1. D SET^IBCNSP(START+2,OFFSET," Provider: "_$E($P($G(^VA(200,+$P($G(IBSDV(2)),"^",2),0)),"^"),1,23)) ;sdd(409.44
  1. D SET^IBCNSP(START+3,OFFSET," Diagnosis: "_$E($$DIAG^IBTRE6(+$P($G(IBSDX(1)),"^",2),1,IBDATE),1,23)) ;sdd(409.43
  1. D SET^IBCNSP(START+4,OFFSET," Diagnosis: "_$E($$DIAG^IBTRE6(+$P($G(IBSDX(2)),"^",2),1,IBDATE),1,23)) ;sdd(409.43
  1. D SET^IBCNSP(START+5,OFFSET," Special Cond: "_$$ENCL^IBTRED(IBOE))
  1. Q
  1. ;
  1. BILL ; -- billing information region
  1. N OFFSET,START,IBBIL,IBECME,IBECMEN,IBCOMM
  1. S START=15,OFFSET=2
  1. S IBBIL=+$P(IBTRND,"^",11)
  1. S IBDGCR=$G(^DGCR(399,IBBIL,0)),IBDGCRU1=$G(^("U1"))
  1. S IBECMEN=$P($P($G(^DGCR(399,IBBIL,"M1")),U,8),";") ;ecme#
  1. S IBECME=''IBECMEN
  1. S IBAMNT=$$BILLD^IBTRED1(IBTRN)
  1. D SET^IBCNSP(START,OFFSET+20," Billing Information ",IORVON,IORVOFF)
  1. D SET^IBCNSP(START+1,OFFSET," Episode Billable: "_$S(+$P(IBTRND,"^",19):"NO",1:"YES"))
  1. D SET^IBCNSP(START+2,OFFSET," Non-Billable Reason: "_$E($P($G(^IBE(356.8,+$P(IBTRND,"^",19),0)),"^"),1,20))
  1. D SET^IBCNSP(START+3,OFFSET," Next Bill Date: "_$$DAT1^IBOUTL($P(IBTRND,"^",17)))
  1. D SET^IBCNSP(START+4,OFFSET,"Work. Comp/OWCP/Tort: "_$E($$EXPAND^IBTRE(356,.12,$P(IBTRND,"^",12)),1,14))
  1. D SET^IBCNSP(START+5,OFFSET," Initial Bill: "_$P(IBDGCR,"^")_$S(IBECME:"e",1:""))
  1. I IBECME D SET^IBCNSP(START+6,OFFSET," ECME Number: "_IBECMEN)
  1. D SET^IBCNSP(START+6+IBECME,OFFSET," Bill Status: "_$E($$EXPAND^IBTRE(399,.13,$P(IBDGCR,"^",13)),1,14))
  1. ;S IBCOMM="" I +$P(IBTRND,"^",19) ; removed 'IF' for displaying the comment
  1. S IBCOMM=$E($P(IBTRND1,"^",8),1,60)
  1. I IBCOMM'="" D SET^IBCNSP(START+7+IBECME,OFFSET," Additional Comment: "_IBCOMM)
  1. I $P($G(^IBT(356,IBTRN,3,0)),"^",3) D
  1. . N IBX,IBY
  1. . S IBY="",IBX=0 F S IBX=$O(^IBT(356,IBTRN,3,IBX)) Q:'IBX S IBY($P($G(^IBT(356.85,+$G(^IBT(356,IBTRN,3,IBX,0)),0)),"^"))=""
  1. . S IBX="" F S IBX=$O(IBY(IBX)) Q:IBX="" S IBY=IBY_$S($L(IBY):", ",1:"")_IBX
  1. . D SET^IBCNSP(START+($S(+$P(IBTRND,"^",19):8,1:7)),OFFSET," Billable Findings: "_IBY)
  1. D BILL1
  1. Q
  1. ;
  1. BILL1 ; -- other side of billing info
  1. N OFFSET,START
  1. S START=15,OFFSET=45
  1. D SET^IBCNSP(START+1,OFFSET," Total Charges: $ "_$J($P(IBAMNT,"^"),8))
  1. D SET^IBCNSP(START+2,OFFSET,"Estimated Recv (Pri): $ "_$J($P(IBTRND,"^",21),8))
  1. D SET^IBCNSP(START+3,OFFSET,"Estimated Recv (Sec): $ "_$J($P(IBTRND,"^",22),8))
  1. D SET^IBCNSP(START+4,OFFSET,"Estimated Recv (ter): $ "_$J($P(IBTRND,"^",23),8))
  1. D SET^IBCNSP(START+5,OFFSET," Means Test Charges: $ "_$J($P(IBTRND,"^",28),8))
  1. D SET^IBCNSP(START+6,OFFSET," Amount Paid: $ "_$J($P(IBAMNT,"^",2),8))
  1. Q
  1. ;
  1. PRE ; -- pre-certification region
  1. N OFFSET,START,IBTRC,IBTRCD
  1. ;S START=15,OFFSET=45
  1. S START=1,OFFSET=45
  1. D SET^IBCNSP(START,OFFSET," Treatment Authorization Info ",IORVON,IORVOFF)
  1. D SET^IBCNSP(START+1,OFFSET,"Authorization #: "_$$PRECRT^IBTRC1(IBTRN,18))
  1. D SET^IBCNSP(START+2,OFFSET," No. Days Approved: "_$J($$DAY^IBTRE(IBTRN),3))
  1. D SET^IBCNSP(START+3,OFFSET,"Second Opinion Required: "_$$EXPAND^IBTRE(356,.14,$P(IBTRND,"^",14)))
  1. D SET^IBCNSP(START+4,OFFSET,"Second Opinion Obtained: "_$$EXPAND^IBTRE(356,.15,$P(IBTRND,"^",15)))
  1. Q
  1. ;
  1. SPCOND(IBTRN) ; -- see if sc or other special condition for patient
  1. ; -- if inpt. look in ptf. if opt look opt encounter file
  1. ;
  1. Q ""