- 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 Apr 23, 2025@18:22:26 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")
