IBATLM2A ;LL/ELZ - TRANSFER PRICING PT TRANSACTION DETAIL ; 15-SEP-1998
;;2.0;INTEGRATED BILLING;**115,210,266,309,389**;21-MAR-94;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
;
N IBX,IBY K ^TMP("IBATEE",$J)
F IBX=0,4,5,6 S IBDATA(IBX)=$G(^IBAT(351.61,IBIEN,IBX))
;
S IBY=""
D SET("*** General Information ***",.IBY,26,27)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,26,27,IOINHI,IOINORM)
D SETVALM(.VALMCNT,"")
;
D SET("Transaction Date:",.IBY,1,17)
D SET($$DATE($P(IBDATA(0),"^",3)),.IBY,19,19)
D SET("Event Date:",.IBY,48,11)
D SET($$DATE($P(IBDATA(0),"^",4)),.IBY,60,20)
D SETVALM(.VALMCNT,.IBY)
;
D SET("Status:",.IBY,11,7)
D SET($$EX^IBATUTL(351.61,.05,$P(IBDATA(0),"^",5)),.IBY,19,19)
D SET("Priced Date:",.IBY,47,12)
D SET($$DATE($P(IBDATA(0),"^",13)),.IBY,60,20)
D SETVALM(.VALMCNT,.IBY)
;
D SET("From Date:",.IBY,8,10)
D SET($$DATE($P(IBDATA(0),"^",9)),.IBY,19,19)
D SET("To Date:",.IBY,51,8)
D SET($$DATE($P(IBDATA(0),"^",10)),.IBY,60,20)
D SETVALM(.VALMCNT,.IBY)
;
D SET("Facility:",.IBY,9,9)
D SET($$EX^IBATUTL(351.61,.11,$P(IBDATA(0),"^",11)),.IBY,19,19)
D SETVALM(.VALMCNT,.IBY),SETVALM(.VALMCNT,""),SETVALM(.VALMCNT,"")
;
D SET("*** Workload/Pricing Detail ***",.IBY,24,31)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
;
D @$S($P(IBDATA(0),"^",12)["DGPM(":"INPT",$P(IBDATA(0),"^",12)["SCE(":"OUT",$P(IBDATA(0),"^",12)["RMPR(":"RMPR",1:"RX")
;
D SETVALM(.VALMCNT,"")
D SET("*** Totals ***",.IBY,33,14)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,26,28,IOINHI,IOINORM)
D SETVALM(.VALMCNT,"")
;
D SET("Bill Amount:",.IBY,6,18)
D SET($FN($P(IBDATA(6),"^",2),"",2),.IBY,25,54)
D SETVALM(.VALMCNT,.IBY)
;
D SET("Patient Copay:",.IBY,6,14)
S $P(IBDATA(6),"^",3)=$$COPAY^IBATUTL(DFN,$P(IBDATA(0),"^",12),$P(IBDATA(0),"^",9),$P(IBDATA(0),"^",10))
D SET($FN($P(IBDATA(6),"^",3),"",2),.IBY,26,54)
D SETVALM(.VALMCNT,.IBY)
;
Q
INPT ; -- detail display for inpatient
N IBDRG,VAIP
;
S IBDRG=$G(^IBAT(351.61,IBIEN,1))
;
S VAIP("E")=+$P(IBDATA(0),"^",12) D IN5^VADPT
;
D SETVALM(.VALMCNT,"")
D SET("Admission Date:",.IBY,3,15)
D SET($P(VAIP(13,1),"^",2),.IBY,19,19)
D SET("Discharge Date:",.IBY,44,15)
D SET($P(VAIP(17,1),"^",2),.IBY,60,20)
D SETVALM(.VALMCNT,.IBY)
;
D SET("Ward Location:",.IBY,4,14)
D SET($P(VAIP(5),"^",2),.IBY,19,19)
D SET("Treating Specialty:",.IBY,40,19)
D SET($P(VAIP(8),"^",2),.IBY,60,20)
D SETVALM(.VALMCNT,.IBY)
;
D SET("DRG:",.IBY,14,4)
D SET($$EX^IBATUTL(351.61,1.01,$P(IBDRG,"^")),.IBY,19,19)
D SET("DRG Charge:",.IBY,48,11)
D SET($FN($P(IBDRG,"^",2),"",2),.IBY,60,20)
D SETVALM(.VALMCNT,.IBY)
;
D SET("Inpatient LOS:",.IBY,4,14)
D SET(+$P(IBDRG,"^",3),.IBY,19,19)
D SET("High Trim Days:",.IBY,44,15)
D SET(+$P(IBDRG,"^",4),.IBY,60,20)
D SETVALM(.VALMCNT,.IBY)
;
D SET("Outlier Days:",.IBY,5,13)
D SET(+$P(IBDRG,"^",5),.IBY,19,19)
D SET("Outlier Rate:",.IBY,46,13)
D SET($FN($P(IBDRG,"^",6),"",2),.IBY,60,20)
D SETVALM(.VALMCNT,.IBY)
Q
OUT ; -- detail display for outpatient
N IBX,IBDXLIST,IBSCE,IBPROV,IBDATE
;
D GETGEN^SDOE($P($P(IBDATA(0),"^",12),";"),"IBSCE")
D GETPRV^SDOE($P($P(IBDATA(0),"^",12),";"),"IBPROV")
;
D GETDX^SDOE($P($P(IBDATA(0),"^",12),";"),"IBDXLIST")
S IBDATE=$P($G(IBDATA(0)),U,4) ; Event date
D DX(.IBDXLIST,IBDATE)
;
D SET("Procedure Information:",.IBY,1,22)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,1,22,IOINHI,IOINORM)
;
S IBX=0 F S IBX=$O(^IBAT(351.61,IBIEN,3,IBX)) Q:IBX<1 D
. S IBX(0)=$G(^IBAT(351.61,IBIEN,3,IBX,0))
. S IBX(1)=$$PROC^IBATUTL($P(IBX(0),U),IBDATE)
. ;
. D SET(+IBX(1),.IBY,5,6)
. D SET("-",.IBY,13,1)
. D SET($P(IBX(1),"^",2),.IBY,15,40)
. D SET(+$P(IBX(0),"^",2),.IBY,57,3)
. D SET("x",.IBY,62,1)
. D SET($FN($P(IBX(0),"^",3),"",2),.IBY,64,15)
. D SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
;
D SET("Visit Information:",.IBY,1,18)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,1,22,IOINHI,IOINORM)
;
D SET("Location:",.IBY,8,14)
D SET($P(^SC(+$P(IBSCE(0),"^",4),0),"^"),.IBY,19,46) ; dbia 10040
D SETVALM(.VALMCNT,.IBY)
;
D SETVALM(.VALMCNT,"")
D SET("Provider(s):",.IBY,5,17)
S IBX=0 F S IBX=$O(IBPROV(IBX)) Q:IBX<.5 D
. D SET($$GET1^DIQ(200,+IBPROV(IBX),.01),.IBY,19,49) ; dbia 10060
. D SETVALM(.VALMCNT,.IBY)
;
Q
RX ; -- detail display for rx
D SET("Drug:",.IBY,5,5)
D ZERO^IBRXUTL(+IBDATA(4))
D SET(^TMP($J,"IBDRUG",+IBDATA(4),.01),.IBY,12,40) ; dbia 4533
D SET(+$P(IBDATA(4),"^",2),.IBY,55,3)
D SET("x",.IBY,60,1)
D SET($FN($P(IBDATA(4),"^",3),"",3),.IBY,62,15)
D SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
K ^TMP($J,"IBDRUG")
Q
RMPR ; -- detail display for prosthetic
D SETVALM(.VALMCNT,"")
D SET("Prosthetic Item:",.IBY,5,16)
D SET($P($$PIN^IBATUTL(+$P(IBDATA(0),"^",12)),U,2),.IBY,23,30) ; dbia 374
D SET($FN($P(IBDATA(4),"^",5),",",2),.IBY,58,15)
D SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
Q
DX(IBDX,IBDATE) ; -- diagnosis info
N IBX
;
D SETVALM(.VALMCNT,"")
D SET("Diagnosis Information:",.IBY,1,22)
D SETVALM(.VALMCNT,.IBY)
D CNTRL^VALM10(VALMCNT,1,22,IOINHI,IOINORM)
;
S IBX=0 F S IBX=$O(IBDX(IBX)) Q:IBX<1 D
. S IBX(0)=$$ICD9^IBACSV(+IBDX(IBX),$G(IBDATE))
. ;
. D SET($P(IBX(0),"^"),.IBY,5,7)
. D SET("-",.IBY,14,1)
. D SET($P(IBX(0),"^",3),.IBY,16,30)
. D SETVALM(.VALMCNT,.IBY)
D SETVALM(.VALMCNT,"")
Q
SET(TEXT,STRING,COL,LENGTH) ; -- set up string with valm1
S STRING=$$SETSTR^VALM1($$LOWER^VALM1(TEXT),STRING,COL,LENGTH)
Q
SETVALM(LINE,TEXT) ; -- sets line for display
S LINE=LINE+1
S ^TMP("IBATEE",$J,LINE,0)=TEXT
S TEXT=""
Q
DATE(X) ; -- returns date for display
Q $$FMTE^XLFDT(X,"5D")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBATLM2A 5830 printed Sep 23, 2025@19:44:08 Page 2
IBATLM2A ;LL/ELZ - TRANSFER PRICING PT TRANSACTION DETAIL ; 15-SEP-1998
+1 ;;2.0;INTEGRATED BILLING;**115,210,266,309,389**;21-MAR-94;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 NEW IBX,IBY
KILL ^TMP("IBATEE",$JOB)
+5 FOR IBX=0,4,5,6
SET IBDATA(IBX)=$GET(^IBAT(351.61,IBIEN,IBX))
+6 ;
+7 SET IBY=""
+8 DO SET("*** General Information ***",.IBY,26,27)
+9 DO SETVALM(.VALMCNT,.IBY)
+10 DO CNTRL^VALM10(VALMCNT,26,27,IOINHI,IOINORM)
+11 DO SETVALM(.VALMCNT,"")
+12 ;
+13 DO SET("Transaction Date:",.IBY,1,17)
+14 DO SET($$DATE($PIECE(IBDATA(0),"^",3)),.IBY,19,19)
+15 DO SET("Event Date:",.IBY,48,11)
+16 DO SET($$DATE($PIECE(IBDATA(0),"^",4)),.IBY,60,20)
+17 DO SETVALM(.VALMCNT,.IBY)
+18 ;
+19 DO SET("Status:",.IBY,11,7)
+20 DO SET($$EX^IBATUTL(351.61,.05,$PIECE(IBDATA(0),"^",5)),.IBY,19,19)
+21 DO SET("Priced Date:",.IBY,47,12)
+22 DO SET($$DATE($PIECE(IBDATA(0),"^",13)),.IBY,60,20)
+23 DO SETVALM(.VALMCNT,.IBY)
+24 ;
+25 DO SET("From Date:",.IBY,8,10)
+26 DO SET($$DATE($PIECE(IBDATA(0),"^",9)),.IBY,19,19)
+27 DO SET("To Date:",.IBY,51,8)
+28 DO SET($$DATE($PIECE(IBDATA(0),"^",10)),.IBY,60,20)
+29 DO SETVALM(.VALMCNT,.IBY)
+30 ;
+31 DO SET("Facility:",.IBY,9,9)
+32 DO SET($$EX^IBATUTL(351.61,.11,$PIECE(IBDATA(0),"^",11)),.IBY,19,19)
+33 DO SETVALM(.VALMCNT,.IBY)
DO SETVALM(.VALMCNT,"")
DO SETVALM(.VALMCNT,"")
+34 ;
+35 DO SET("*** Workload/Pricing Detail ***",.IBY,24,31)
+36 DO SETVALM(.VALMCNT,.IBY)
+37 DO CNTRL^VALM10(VALMCNT,24,31,IOINHI,IOINORM)
+38 ;
+39 DO @$SELECT($PIECE(IBDATA(0),"^",12)["DGPM(":"INPT",$PIECE(IBDATA(0),"^",12)["SCE(":"OUT",$PIECE(IBDATA(0),"^",12)["RMPR(":"RMPR",1:"RX")
+40 ;
+41 DO SETVALM(.VALMCNT,"")
+42 DO SET("*** Totals ***",.IBY,33,14)
+43 DO SETVALM(.VALMCNT,.IBY)
+44 DO CNTRL^VALM10(VALMCNT,26,28,IOINHI,IOINORM)
+45 DO SETVALM(.VALMCNT,"")
+46 ;
+47 DO SET("Bill Amount:",.IBY,6,18)
+48 DO SET($FNUMBER($PIECE(IBDATA(6),"^",2),"",2),.IBY,25,54)
+49 DO SETVALM(.VALMCNT,.IBY)
+50 ;
+51 DO SET("Patient Copay:",.IBY,6,14)
+52 SET $PIECE(IBDATA(6),"^",3)=$$COPAY^IBATUTL(DFN,$PIECE(IBDATA(0),"^",12),$PIECE(IBDATA(0),"^",9),$PIECE(IBDATA(0),"^",10))
+53 DO SET($FNUMBER($PIECE(IBDATA(6),"^",3),"",2),.IBY,26,54)
+54 DO SETVALM(.VALMCNT,.IBY)
+55 ;
+56 QUIT
INPT ; -- detail display for inpatient
+1 NEW IBDRG,VAIP
+2 ;
+3 SET IBDRG=$GET(^IBAT(351.61,IBIEN,1))
+4 ;
+5 SET VAIP("E")=+$PIECE(IBDATA(0),"^",12)
DO IN5^VADPT
+6 ;
+7 DO SETVALM(.VALMCNT,"")
+8 DO SET("Admission Date:",.IBY,3,15)
+9 DO SET($PIECE(VAIP(13,1),"^",2),.IBY,19,19)
+10 DO SET("Discharge Date:",.IBY,44,15)
+11 DO SET($PIECE(VAIP(17,1),"^",2),.IBY,60,20)
+12 DO SETVALM(.VALMCNT,.IBY)
+13 ;
+14 DO SET("Ward Location:",.IBY,4,14)
+15 DO SET($PIECE(VAIP(5),"^",2),.IBY,19,19)
+16 DO SET("Treating Specialty:",.IBY,40,19)
+17 DO SET($PIECE(VAIP(8),"^",2),.IBY,60,20)
+18 DO SETVALM(.VALMCNT,.IBY)
+19 ;
+20 DO SET("DRG:",.IBY,14,4)
+21 DO SET($$EX^IBATUTL(351.61,1.01,$PIECE(IBDRG,"^")),.IBY,19,19)
+22 DO SET("DRG Charge:",.IBY,48,11)
+23 DO SET($FNUMBER($PIECE(IBDRG,"^",2),"",2),.IBY,60,20)
+24 DO SETVALM(.VALMCNT,.IBY)
+25 ;
+26 DO SET("Inpatient LOS:",.IBY,4,14)
+27 DO SET(+$PIECE(IBDRG,"^",3),.IBY,19,19)
+28 DO SET("High Trim Days:",.IBY,44,15)
+29 DO SET(+$PIECE(IBDRG,"^",4),.IBY,60,20)
+30 DO SETVALM(.VALMCNT,.IBY)
+31 ;
+32 DO SET("Outlier Days:",.IBY,5,13)
+33 DO SET(+$PIECE(IBDRG,"^",5),.IBY,19,19)
+34 DO SET("Outlier Rate:",.IBY,46,13)
+35 DO SET($FNUMBER($PIECE(IBDRG,"^",6),"",2),.IBY,60,20)
+36 DO SETVALM(.VALMCNT,.IBY)
+37 QUIT
OUT ; -- detail display for outpatient
+1 NEW IBX,IBDXLIST,IBSCE,IBPROV,IBDATE
+2 ;
+3 DO GETGEN^SDOE($PIECE($PIECE(IBDATA(0),"^",12),";"),"IBSCE")
+4 DO GETPRV^SDOE($PIECE($PIECE(IBDATA(0),"^",12),";"),"IBPROV")
+5 ;
+6 DO GETDX^SDOE($PIECE($PIECE(IBDATA(0),"^",12),";"),"IBDXLIST")
+7 ; Event date
SET IBDATE=$PIECE($GET(IBDATA(0)),U,4)
+8 DO DX(.IBDXLIST,IBDATE)
+9 ;
+10 DO SET("Procedure Information:",.IBY,1,22)
+11 DO SETVALM(.VALMCNT,.IBY)
+12 DO CNTRL^VALM10(VALMCNT,1,22,IOINHI,IOINORM)
+13 ;
+14 SET IBX=0
FOR
SET IBX=$ORDER(^IBAT(351.61,IBIEN,3,IBX))
if IBX<1
QUIT
Begin DoDot:1
+15 SET IBX(0)=$GET(^IBAT(351.61,IBIEN,3,IBX,0))
+16 SET IBX(1)=$$PROC^IBATUTL($PIECE(IBX(0),U),IBDATE)
+17 ;
+18 DO SET(+IBX(1),.IBY,5,6)
+19 DO SET("-",.IBY,13,1)
+20 DO SET($PIECE(IBX(1),"^",2),.IBY,15,40)
+21 DO SET(+$PIECE(IBX(0),"^",2),.IBY,57,3)
+22 DO SET("x",.IBY,62,1)
+23 DO SET($FNUMBER($PIECE(IBX(0),"^",3),"",2),.IBY,64,15)
+24 DO SETVALM(.VALMCNT,.IBY)
End DoDot:1
+25 DO SETVALM(.VALMCNT,"")
+26 ;
+27 DO SET("Visit Information:",.IBY,1,18)
+28 DO SETVALM(.VALMCNT,.IBY)
+29 DO CNTRL^VALM10(VALMCNT,1,22,IOINHI,IOINORM)
+30 ;
+31 DO SET("Location:",.IBY,8,14)
+32 ; dbia 10040
DO SET($PIECE(^SC(+$PIECE(IBSCE(0),"^",4),0),"^"),.IBY,19,46)
+33 DO SETVALM(.VALMCNT,.IBY)
+34 ;
+35 DO SETVALM(.VALMCNT,"")
+36 DO SET("Provider(s):",.IBY,5,17)
+37 SET IBX=0
FOR
SET IBX=$ORDER(IBPROV(IBX))
if IBX<.5
QUIT
Begin DoDot:1
+38 ; dbia 10060
DO SET($$GET1^DIQ(200,+IBPROV(IBX),.01),.IBY,19,49)
+39 DO SETVALM(.VALMCNT,.IBY)
End DoDot:1
+40 ;
+41 QUIT
RX ; -- detail display for rx
+1 DO SET("Drug:",.IBY,5,5)
+2 DO ZERO^IBRXUTL(+IBDATA(4))
+3 ; dbia 4533
DO SET(^TMP($JOB,"IBDRUG",+IBDATA(4),.01),.IBY,12,40)
+4 DO SET(+$PIECE(IBDATA(4),"^",2),.IBY,55,3)
+5 DO SET("x",.IBY,60,1)
+6 DO SET($FNUMBER($PIECE(IBDATA(4),"^",3),"",3),.IBY,62,15)
+7 DO SETVALM(.VALMCNT,.IBY)
+8 DO SETVALM(.VALMCNT,"")
+9 KILL ^TMP($JOB,"IBDRUG")
+10 QUIT
RMPR ; -- detail display for prosthetic
+1 DO SETVALM(.VALMCNT,"")
+2 DO SET("Prosthetic Item:",.IBY,5,16)
+3 ; dbia 374
DO SET($PIECE($$PIN^IBATUTL(+$PIECE(IBDATA(0),"^",12)),U,2),.IBY,23,30)
+4 DO SET($FNUMBER($PIECE(IBDATA(4),"^",5),",",2),.IBY,58,15)
+5 DO SETVALM(.VALMCNT,.IBY)
+6 DO SETVALM(.VALMCNT,"")
+7 QUIT
DX(IBDX,IBDATE) ; -- diagnosis info
+1 NEW IBX
+2 ;
+3 DO SETVALM(.VALMCNT,"")
+4 DO SET("Diagnosis Information:",.IBY,1,22)
+5 DO SETVALM(.VALMCNT,.IBY)
+6 DO CNTRL^VALM10(VALMCNT,1,22,IOINHI,IOINORM)
+7 ;
+8 SET IBX=0
FOR
SET IBX=$ORDER(IBDX(IBX))
if IBX<1
QUIT
Begin DoDot:1
+9 SET IBX(0)=$$ICD9^IBACSV(+IBDX(IBX),$GET(IBDATE))
+10 ;
+11 DO SET($PIECE(IBX(0),"^"),.IBY,5,7)
+12 DO SET("-",.IBY,14,1)
+13 DO SET($PIECE(IBX(0),"^",3),.IBY,16,30)
+14 DO SETVALM(.VALMCNT,.IBY)
End DoDot:1
+15 DO SETVALM(.VALMCNT,"")
+16 QUIT
SET(TEXT,STRING,COL,LENGTH) ; -- set up string with valm1
+1 SET STRING=$$SETSTR^VALM1($$LOWER^VALM1(TEXT),STRING,COL,LENGTH)
+2 QUIT
SETVALM(LINE,TEXT) ; -- sets line for display
+1 SET LINE=LINE+1
+2 SET ^TMP("IBATEE",$JOB,LINE,0)=TEXT
+3 SET TEXT=""
+4 QUIT
DATE(X) ; -- returns date for display
+1 QUIT $$FMTE^XLFDT(X,"5D")
