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