IBAECU3 ;WOIFO/SS-LTC PHASE 2 UTILITIES ; 20-FEB-02
;;2.0;INTEGRATED BILLING;**176,454**;21-MAR-94;Build 4
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;****** Outpatient LTC related utilities *********
;/*--
;Returns info about all visits via ^TMP($J,IBLB,IBDFN) global
;
;Input:
;
;IBFRBEG- first date (in FM format),must be a valid,
; (wrong date like 3000231 will cause mistakes)
;IBFREND- last date (in FM format),must be a valid date
; if any of dates above > yesterday it will be set to yesterday
;
;IBDFN - patient's ien in file (#2)
;IBLB - any string to identify results in ^TMP($J,IBLB
;Output:
;
;temp global array with inpatient info:
; ^TMP($J,IBLB,IBDFN,date,"M"/"L",IEN40968)=L/M^stopcode^
;
; where pieces:
; #1 - "L" for LTC, "M" for MeansTest
; #2 - stopcode
; #3 - empty
; #4 - pointer to #350.1 IB action type
;Returns:
; 0 - none
; 1 - if any leave or stay days in the period
OUTPINFO(IBFRBEG,IBFREND,IBDFN,IBLB) ;
N IBVAL,IBCBK,IBFILTER,IBRES
S IBVAL("DFN")=IBDFN,IBVAL("BDT")=IBFRBEG-.1,IBVAL("EDT")=+(IBFREND_".9999999")
S IBFILTER=""
; we look only for STATUS=CHECKED OUT i.e. $P(Y0,U,12)=2 in IBCBK
; consider only parent encounters, appts checked out, don't include
; if the date is when they are CD exempt
S IBCBK="I '$P(Y0,U,6),$P(Y0,U,12)=2 S:'$$CDEXMPT^IBAECU(IBDFN,$P(Y0,U)/1) IBRES=$$STOPINFO^IBAECU3($P(Y0,U,3),0),^TMP($J,IBLB,IBDFN,+Y0\1,Y)=IBRES"
D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
Q +$O(^TMP($J,IBLB,IBDFN,0))>0
;/**
;get stop-code related info
;IB407 pointer to file #40.7
;IBDT - date to get rate, if 0 then will not return a rate in 3rd piece
;returns
;IBTYPE_"^"_IBCODE_"^"_IBRATE_"^"_IBATYP
;IBCARE - "M" for means test, "L" for LTC
;IBCODE - AMIS REPORTING STOP CODE
;IBRATE - rate for LTC, 0 for Means test
;IBATYP - ien of 350.1
STOPINFO(IB407,IBDT) ;
N Y,X
N IBI,IBCR,IBCODE,IBATYP,IBCHG
N IBSCDATA,IBNAME
D DIQ407^IBEMTSCU(IB407,1)
S IBCODE=$G(IBSCDATA(40.7,IB407,1,"E"))
Q:+IBCODE=0 ""
S IBNAME=$P($$LTCSTOP^IBAECU(IB407),"^",2)
Q:IBNAME="" "M^"_IBCODE_"^^"
S IBATYP=$O(^IBE(350.1,"B",IBNAME,0))
Q:+IBATYP=0 ""
S IBCHG=""
I +$G(IBDT)>0 D
. S IBCHG=0
. D COST^IBAUTL2
Q "L^"_IBCODE_"^"_IBCHG_"^"_IBATYP
;
;returns rate for different LTC services
;INPUT:
;IBCARE=1 - outpatient(clinic stopcode),IBTYPE=2 - inpatient(treating specialty)
;IBCODE - treating specialty(outpatient) or clinic stopcode (inpatient)
;IBDT - date of care
;if not found - returns 0
GETRATE(IBCARE,IBCODE,IBDT) ;
N IBCHG,IBATYP,IBTAG
N IBI,IBCR,IBNAME
S:'$D(U) U="^"
S (IBCHG,IBATYP)=0
S:IBCARE=1 IBTAG="C"_IBCODE,IBNAME=$P($T(@IBTAG^IBAECU1),";",3)
S:IBCARE=2 IBTAG="T"_IBCODE,IBNAME=$P($T(@IBTAG^IBAECU1),";",3)
Q:IBNAME="" IBCHG
S IBATYP=$O(^IBE(350.1,"B",IBNAME,0))
Q:+IBATYP=0 IBCHG
D COST^IBAUTL2
Q IBCHG_"^"_IBATYP
;/**
;is there any outp episode with that day
;Input:
;IBDFN - dfn of the patient
;IBDT1 - date
;IBTMPLB - ^TMP global subscript like IBADM in $$INPINFO
;Output:
;Returns "a^b" where :
;a - number of LTC admissions on this date
;b - number of Means Test admissions on this date
;if "" - nothing
; means test:
;.IBVIS("M",#)=treating specialty^
; LTC:
;.IBVIS("L",#)=treating specialty^ien of 350.1I action type
ISOUTP(IBDFN,IBDT1,IBTMPLB,IBVIS) ;*/
N IB40968,IBRETV,IBD,IB1
S IB40968=0,IBRETV=""
F S IB40968=$O(^TMP($J,IBTMPLB,IBDFN,IBDT1,IB40968)) Q:+IB40968=0 D
. S IBD=$G(^TMP($J,IBTMPLB,IBDFN,IBDT1,IB40968))
. S IB1=$P(IBD,"^",1)
. I IB1="L" S $P(IBRETV,"^",1)=$P($G(IBRETV),"^",1)+1
. I IB1="M" S $P(IBRETV,"^",2)=$P($G(IBRETV),"^",2)+1
. S IBVIS(IB1,IB40968)=$P(IBD,"^",2)_"^"_$P(IBD,"^",4)
Q IBRETV
;
;checks if there is Means test outpatient visits this date and
;cancels them if there is a charge
CHKMTOUT(IBDFN,IBDT,IBTMPLB) ;
N IBV1
N RETIENS S RETIENS=0
S IBV1=$$ISOUTP(IBDFN,IBDT,IBTMPLB,.RETIENS) Q:+$P(IBV1,"^",2)=0
S IBV1=0
F S IBV1=$O(RETIENS("M",IBV1)) Q:+IBV1=0 D
. D CANCVIS^IBAECU5(IBDFN,IBDT)
Q
;
;
;return IB action type based on treating specialty (42.4)
;or clinic stop code
;IBCARE=1 - outpatient(clinic stopcode),IBTYPE=2 - inpatient(treating specialty)
;IBCODE - treating specialty(outpatient) or clinic stopcode (inpatient)
GET3501(IBCARE,IBCODE) ;
N IBATYP,IBNAME
S:IBCARE=1 IBTAG="C"_IBCODE,IBNAME=$P($T(@IBTAG^IBAECU1),";",3)
S:IBCARE=2 IBTAG="T"_IBCODE,IBNAME=$P($T(@IBTAG^IBAECU1),";",3)
Q:IBNAME="" 0
S IBATYP=$O(^IBE(350.1,"B",IBNAME,0))
Q +IBATYP
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAECU3 4676 printed Apr 09, 2024@21:20:12 Page 2
IBAECU3 ;WOIFO/SS-LTC PHASE 2 UTILITIES ; 20-FEB-02
+1 ;;2.0;INTEGRATED BILLING;**176,454**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;****** Outpatient LTC related utilities *********
+5 ;/*--
+6 ;Returns info about all visits via ^TMP($J,IBLB,IBDFN) global
+7 ;
+8 ;Input:
+9 ;
+10 ;IBFRBEG- first date (in FM format),must be a valid,
+11 ; (wrong date like 3000231 will cause mistakes)
+12 ;IBFREND- last date (in FM format),must be a valid date
+13 ; if any of dates above > yesterday it will be set to yesterday
+14 ;
+15 ;IBDFN - patient's ien in file (#2)
+16 ;IBLB - any string to identify results in ^TMP($J,IBLB
+17 ;Output:
+18 ;
+19 ;temp global array with inpatient info:
+20 ; ^TMP($J,IBLB,IBDFN,date,"M"/"L",IEN40968)=L/M^stopcode^
+21 ;
+22 ; where pieces:
+23 ; #1 - "L" for LTC, "M" for MeansTest
+24 ; #2 - stopcode
+25 ; #3 - empty
+26 ; #4 - pointer to #350.1 IB action type
+27 ;Returns:
+28 ; 0 - none
+29 ; 1 - if any leave or stay days in the period
OUTPINFO(IBFRBEG,IBFREND,IBDFN,IBLB) ;
+1 NEW IBVAL,IBCBK,IBFILTER,IBRES
+2 SET IBVAL("DFN")=IBDFN
SET IBVAL("BDT")=IBFRBEG-.1
SET IBVAL("EDT")=+(IBFREND_".9999999")
+3 SET IBFILTER=""
+4 ; we look only for STATUS=CHECKED OUT i.e. $P(Y0,U,12)=2 in IBCBK
+5 ; consider only parent encounters, appts checked out, don't include
+6 ; if the date is when they are CD exempt
+7 SET IBCBK="I '$P(Y0,U,6),$P(Y0,U,12)=2 S:'$$CDEXMPT^IBAECU(IBDFN,$P(Y0,U)/1) IBRES=$$STOPINFO^IBAECU3($P(Y0,U,3),0),^TMP($J,IBLB,IBDFN,+Y0\1,Y)=IBRES"
+8 DO SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1)
KILL ^TMP("DIERR",$JOB)
+9 QUIT +$ORDER(^TMP($JOB,IBLB,IBDFN,0))>0
+10 ;/**
+11 ;get stop-code related info
+12 ;IB407 pointer to file #40.7
+13 ;IBDT - date to get rate, if 0 then will not return a rate in 3rd piece
+14 ;returns
+15 ;IBTYPE_"^"_IBCODE_"^"_IBRATE_"^"_IBATYP
+16 ;IBCARE - "M" for means test, "L" for LTC
+17 ;IBCODE - AMIS REPORTING STOP CODE
+18 ;IBRATE - rate for LTC, 0 for Means test
+19 ;IBATYP - ien of 350.1
STOPINFO(IB407,IBDT) ;
+1 NEW Y,X
+2 NEW IBI,IBCR,IBCODE,IBATYP,IBCHG
+3 NEW IBSCDATA,IBNAME
+4 DO DIQ407^IBEMTSCU(IB407,1)
+5 SET IBCODE=$GET(IBSCDATA(40.7,IB407,1,"E"))
+6 if +IBCODE=0
QUIT ""
+7 SET IBNAME=$PIECE($$LTCSTOP^IBAECU(IB407),"^",2)
+8 if IBNAME=""
QUIT "M^"_IBCODE_"^^"
+9 SET IBATYP=$ORDER(^IBE(350.1,"B",IBNAME,0))
+10 if +IBATYP=0
QUIT ""
+11 SET IBCHG=""
+12 IF +$GET(IBDT)>0
Begin DoDot:1
+13 SET IBCHG=0
+14 DO COST^IBAUTL2
End DoDot:1
+15 QUIT "L^"_IBCODE_"^"_IBCHG_"^"_IBATYP
+16 ;
+17 ;returns rate for different LTC services
+18 ;INPUT:
+19 ;IBCARE=1 - outpatient(clinic stopcode),IBTYPE=2 - inpatient(treating specialty)
+20 ;IBCODE - treating specialty(outpatient) or clinic stopcode (inpatient)
+21 ;IBDT - date of care
+22 ;if not found - returns 0
GETRATE(IBCARE,IBCODE,IBDT) ;
+1 NEW IBCHG,IBATYP,IBTAG
+2 NEW IBI,IBCR,IBNAME
+3 if '$DATA(U)
SET U="^"
+4 SET (IBCHG,IBATYP)=0
+5 if IBCARE=1
SET IBTAG="C"_IBCODE
SET IBNAME=$PIECE($TEXT(@IBTAG^IBAECU1),";",3)
+6 if IBCARE=2
SET IBTAG="T"_IBCODE
SET IBNAME=$PIECE($TEXT(@IBTAG^IBAECU1),";",3)
+7 if IBNAME=""
QUIT IBCHG
+8 SET IBATYP=$ORDER(^IBE(350.1,"B",IBNAME,0))
+9 if +IBATYP=0
QUIT IBCHG
+10 DO COST^IBAUTL2
+11 QUIT IBCHG_"^"_IBATYP
+12 ;/**
+13 ;is there any outp episode with that day
+14 ;Input:
+15 ;IBDFN - dfn of the patient
+16 ;IBDT1 - date
+17 ;IBTMPLB - ^TMP global subscript like IBADM in $$INPINFO
+18 ;Output:
+19 ;Returns "a^b" where :
+20 ;a - number of LTC admissions on this date
+21 ;b - number of Means Test admissions on this date
+22 ;if "" - nothing
+23 ; means test:
+24 ;.IBVIS("M",#)=treating specialty^
+25 ; LTC:
+26 ;.IBVIS("L",#)=treating specialty^ien of 350.1I action type
ISOUTP(IBDFN,IBDT1,IBTMPLB,IBVIS) ;*/
+1 NEW IB40968,IBRETV,IBD,IB1
+2 SET IB40968=0
SET IBRETV=""
+3 FOR
SET IB40968=$ORDER(^TMP($JOB,IBTMPLB,IBDFN,IBDT1,IB40968))
if +IB40968=0
QUIT
Begin DoDot:1
+4 SET IBD=$GET(^TMP($JOB,IBTMPLB,IBDFN,IBDT1,IB40968))
+5 SET IB1=$PIECE(IBD,"^",1)
+6 IF IB1="L"
SET $PIECE(IBRETV,"^",1)=$PIECE($GET(IBRETV),"^",1)+1
+7 IF IB1="M"
SET $PIECE(IBRETV,"^",2)=$PIECE($GET(IBRETV),"^",2)+1
+8 SET IBVIS(IB1,IB40968)=$PIECE(IBD,"^",2)_"^"_$PIECE(IBD,"^",4)
End DoDot:1
+9 QUIT IBRETV
+10 ;
+11 ;checks if there is Means test outpatient visits this date and
+12 ;cancels them if there is a charge
CHKMTOUT(IBDFN,IBDT,IBTMPLB) ;
+1 NEW IBV1
+2 NEW RETIENS
SET RETIENS=0
+3 SET IBV1=$$ISOUTP(IBDFN,IBDT,IBTMPLB,.RETIENS)
if +$PIECE(IBV1,"^",2)=0
QUIT
+4 SET IBV1=0
+5 FOR
SET IBV1=$ORDER(RETIENS("M",IBV1))
if +IBV1=0
QUIT
Begin DoDot:1
+6 DO CANCVIS^IBAECU5(IBDFN,IBDT)
End DoDot:1
+7 QUIT
+8 ;
+9 ;
+10 ;return IB action type based on treating specialty (42.4)
+11 ;or clinic stop code
+12 ;IBCARE=1 - outpatient(clinic stopcode),IBTYPE=2 - inpatient(treating specialty)
+13 ;IBCODE - treating specialty(outpatient) or clinic stopcode (inpatient)
GET3501(IBCARE,IBCODE) ;
+1 NEW IBATYP,IBNAME
+2 if IBCARE=1
SET IBTAG="C"_IBCODE
SET IBNAME=$PIECE($TEXT(@IBTAG^IBAECU1),";",3)
+3 if IBCARE=2
SET IBTAG="T"_IBCODE
SET IBNAME=$PIECE($TEXT(@IBTAG^IBAECU1),";",3)
+4 if IBNAME=""
QUIT 0
+5 SET IBATYP=$ORDER(^IBE(350.1,"B",IBNAME,0))
+6 QUIT +IBATYP
+7 ;
