- IBAMTV1 ;ALB/CPM - BUILD ARRAY OF BILLABLE EPISODES ; 31-MAY-94
- ;;2.0;INTEGRATED BILLING;**15,33,91,132,153,293**;21-MAR-94;Build 1
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- CARE ; Build an array of episodes to be back-billed.
- ;
- ; Input: IBSTART -- First date that the patient is Means Test billable
- ; IBEND -- Last date that the patient is Means Test billable
- ; DFN -- Pointer to the patient in file #2
- ;
- ; Output: ^TMP("IBAMTV",$J,episode date) = 1^2^3, where
- ; 1 = adm date for inpatient care
- ; visit date for outpatient care
- ; 2 = disch/last bill date for inpatient care
- ; null for outpatient care
- ; 3 = null for inpatient care
- ; softlink for outpatient care
- ;
- K ^TMP("IBAMTV",$J)
- ;
- ; - inpatient at IBSTART?
- S VAINDT=IBSTART\1_.2359 D ADM^VADPT2
- I VADMVT D
- .S IBA=$$ORIG(VADMVT),IBADM=+$G(^DGPM(IBA,0))\1
- .Q:+$$MVT^DGPMOBS(IBA)
- .S IBDIS=+$G(^DGPM(+$P($G(^DGPM(IBA,0)),"^",17),0))\1
- .S:'IBDIS!(IBDIS>IBEND) IBDIS=$$FMADD^XLFDT(IBEND,1)
- .S ^TMP("IBAMTV",$J,IBADM)=(IBSTART\1)_"^"_IBDIS
- ;
- ; - get subsequent admissions
- S IBD="" F S IBD=$O(^DGPM("ATID1",DFN,IBD)) Q:'IBD!((9999999.9999999-IBD)\1'>IBSTART) S IBA=+$O(^(IBD,0)) D
- .S IBADM0=$G(^DGPM(IBA,0))
- .Q:+IBADM0>IBEND ; adm after end date for MT
- .Q:+$$MVT^DGPMOBS(IBA) ; adm for obs & examination
- .Q:$$ASIH^IBAUTL5(IBADM0) ; asih admission (catch it later)
- .;
- .S IBDIS=+$G(^DGPM(+$P($G(^DGPM(IBA,0)),"^",17),0))\1
- .S:'IBDIS!(IBDIS>IBEND) IBDIS=$$FMADD^XLFDT(IBEND,1)
- .S ^TMP("IBAMTV",$J,+IBADM0\1)=(+IBADM0\1)_"^"_IBDIS
- ;
- ; Outpatient encounters
- N IBVAL,IBCBK,IBFILTER,IBOE,IBOE0,IBCK,IBT,IBPB,Z
- S IBVAL("DFN")=DFN,IBVAL("BDT")=IBSTART,IBVAL("EDT")=IBEND
- ; Only parent encounters
- S IBFILTER=""
- S IBCBK="I '$P(Y0,U,6) S ^TMP(""IBOE"",$J,+$P(Y0,U,8),Y)=Y0"
- K ^TMP("IBOE",$J)
- D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
- F Z=0:1:6,9,10,13 S IBCK(Z)=""
- S IBT=0 F S IBT=$O(^TMP("IBOE",$J,IBT)) Q:'IBT D
- . S IBOE=0 F S IBOE=$O(^TMP("IBOE",$J,IBT,IBOE)) Q:'IBOE S IBOE0=$G(^(IBOE)) D
- .. K IBPB
- .. I $$BILLCK^IBAMTEDU(IBOE,IBOE0,.IBCK,.IBPB) D
- ... S Z=$O(IBPB(0)) Q:'Z
- ...;
- ... ;Check any visits for that date for dispositions, add-edits
- ... I Z=3 Q:$D(^TMP("IBAMTV",$J,IBOE0\1))
- ... I Z=2 Q:$S($D(^TMP("IBAMTV",$J,IBOE0\1)):1,1:$$NBCSC^IBEFUNC($P(IBOE0,U,3),IBOE0\1))
- ...;
- ... S ^TMP("IBAMTV",$J,IBOE0\1)=IBOE0\1_U_U_IBOE
- K ^TMP("IBOE",$J)
- ;
- K IBA,IBADM,IBADM0,IBAD,IBD,IBDIS,IBDT,IBI,VAINDT,VADMVT
- ;
- Q
- ;
- INP(DATE) ; Was the patient an inpatient on DATE?
- ; Input: DATE -- Date of outpatient visit
- ; array IBARR
- ; Output: 1 -- Patient was an inpatient on DATE
- ; 0 -- Patient was not
- N X,Y,Z S X=0
- I '$G(DATE) G INPQ
- S Y=0 F S Y=$O(IBARR(Y)) Q:X!'Y!(Y>DATE) D
- .S Z=0 F S Z=$O(IBARR(Y,Z)) Q:'Z S Z1=$G(IBARR(Y,Z)) I DATE'<+Z1,DATE'>$P(Z1,"^",2) S X=1 Q
- INPQ Q X
- ;
- ORIG(IBA) ; Find first admission pointer, considering ASIH movements
- ; Input: IBA -- Pointer to admission in #405
- ; Output: Z -- Pointer to original admission in #405
- N X,Y,Z S Z=+$G(IBA)
- F S X=$G(^DGPM(Z,0)),Z=$P(X,"^",14),Y=$P(X,"^",21) Q:Y="" S Z=Y
- Q Z
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBAMTV1 3442 printed Feb 18, 2025@23:33:10 Page 2
- IBAMTV1 ;ALB/CPM - BUILD ARRAY OF BILLABLE EPISODES ; 31-MAY-94
- +1 ;;2.0;INTEGRATED BILLING;**15,33,91,132,153,293**;21-MAR-94;Build 1
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- CARE ; Build an array of episodes to be back-billed.
- +1 ;
- +2 ; Input: IBSTART -- First date that the patient is Means Test billable
- +3 ; IBEND -- Last date that the patient is Means Test billable
- +4 ; DFN -- Pointer to the patient in file #2
- +5 ;
- +6 ; Output: ^TMP("IBAMTV",$J,episode date) = 1^2^3, where
- +7 ; 1 = adm date for inpatient care
- +8 ; visit date for outpatient care
- +9 ; 2 = disch/last bill date for inpatient care
- +10 ; null for outpatient care
- +11 ; 3 = null for inpatient care
- +12 ; softlink for outpatient care
- +13 ;
- +14 KILL ^TMP("IBAMTV",$JOB)
- +15 ;
- +16 ; - inpatient at IBSTART?
- +17 SET VAINDT=IBSTART\1_.2359
- DO ADM^VADPT2
- +18 IF VADMVT
- Begin DoDot:1
- +19 SET IBA=$$ORIG(VADMVT)
- SET IBADM=+$GET(^DGPM(IBA,0))\1
- +20 if +$$MVT^DGPMOBS(IBA)
- QUIT
- +21 SET IBDIS=+$GET(^DGPM(+$PIECE($GET(^DGPM(IBA,0)),"^",17),0))\1
- +22 if 'IBDIS!(IBDIS>IBEND)
- SET IBDIS=$$FMADD^XLFDT(IBEND,1)
- +23 SET ^TMP("IBAMTV",$JOB,IBADM)=(IBSTART\1)_"^"_IBDIS
- End DoDot:1
- +24 ;
- +25 ; - get subsequent admissions
- +26 SET IBD=""
- FOR
- SET IBD=$ORDER(^DGPM("ATID1",DFN,IBD))
- if 'IBD!((9999999.9999999-IBD)\1'>IBSTART)
- QUIT
- SET IBA=+$ORDER(^(IBD,0))
- Begin DoDot:1
- +27 SET IBADM0=$GET(^DGPM(IBA,0))
- +28 ; adm after end date for MT
- if +IBADM0>IBEND
- QUIT
- +29 ; adm for obs & examination
- if +$$MVT^DGPMOBS(IBA)
- QUIT
- +30 ; asih admission (catch it later)
- if $$ASIH^IBAUTL5(IBADM0)
- QUIT
- +31 ;
- +32 SET IBDIS=+$GET(^DGPM(+$PIECE($GET(^DGPM(IBA,0)),"^",17),0))\1
- +33 if 'IBDIS!(IBDIS>IBEND)
- SET IBDIS=$$FMADD^XLFDT(IBEND,1)
- +34 SET ^TMP("IBAMTV",$JOB,+IBADM0\1)=(+IBADM0\1)_"^"_IBDIS
- End DoDot:1
- +35 ;
- +36 ; Outpatient encounters
- +37 NEW IBVAL,IBCBK,IBFILTER,IBOE,IBOE0,IBCK,IBT,IBPB,Z
- +38 SET IBVAL("DFN")=DFN
- SET IBVAL("BDT")=IBSTART
- SET IBVAL("EDT")=IBEND
- +39 ; Only parent encounters
- +40 SET IBFILTER=""
- +41 SET IBCBK="I '$P(Y0,U,6) S ^TMP(""IBOE"",$J,+$P(Y0,U,8),Y)=Y0"
- +42 KILL ^TMP("IBOE",$JOB)
- +43 DO SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1)
- KILL ^TMP("DIERR",$JOB)
- +44 FOR Z=0:1:6,9,10,13
- SET IBCK(Z)=""
- +45 SET IBT=0
- FOR
- SET IBT=$ORDER(^TMP("IBOE",$JOB,IBT))
- if 'IBT
- QUIT
- Begin DoDot:1
- +46 SET IBOE=0
- FOR
- SET IBOE=$ORDER(^TMP("IBOE",$JOB,IBT,IBOE))
- if 'IBOE
- QUIT
- SET IBOE0=$GET(^(IBOE))
- Begin DoDot:2
- +47 KILL IBPB
- +48 IF $$BILLCK^IBAMTEDU(IBOE,IBOE0,.IBCK,.IBPB)
- Begin DoDot:3
- +49 SET Z=$ORDER(IBPB(0))
- if 'Z
- QUIT
- +50 ;
- +51 ;Check any visits for that date for dispositions, add-edits
- +52 IF Z=3
- if $DATA(^TMP("IBAMTV",$JOB,IBOE0\1))
- QUIT
- +53 IF Z=2
- if $SELECT($DATA(^TMP("IBAMTV",$JOB,IBOE0\1))
- QUIT
- +54 ;
- +55 SET ^TMP("IBAMTV",$JOB,IBOE0\1)=IBOE0\1_U_U_IBOE
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +56 KILL ^TMP("IBOE",$JOB)
- +57 ;
- +58 KILL IBA,IBADM,IBADM0,IBAD,IBD,IBDIS,IBDT,IBI,VAINDT,VADMVT
- +59 ;
- +60 QUIT
- +61 ;
- INP(DATE) ; Was the patient an inpatient on DATE?
- +1 ; Input: DATE -- Date of outpatient visit
- +2 ; array IBARR
- +3 ; Output: 1 -- Patient was an inpatient on DATE
- +4 ; 0 -- Patient was not
- +5 NEW X,Y,Z
- SET X=0
- +6 IF '$GET(DATE)
- GOTO INPQ
- +7 SET Y=0
- FOR
- SET Y=$ORDER(IBARR(Y))
- if X!'Y!(Y>DATE)
- QUIT
- Begin DoDot:1
- +8 SET Z=0
- FOR
- SET Z=$ORDER(IBARR(Y,Z))
- if 'Z
- QUIT
- SET Z1=$GET(IBARR(Y,Z))
- IF DATE'<+Z1
- IF DATE'>$PIECE(Z1,"^",2)
- SET X=1
- QUIT
- End DoDot:1
- INPQ QUIT X
- +1 ;
- ORIG(IBA) ; Find first admission pointer, considering ASIH movements
- +1 ; Input: IBA -- Pointer to admission in #405
- +2 ; Output: Z -- Pointer to original admission in #405
- +3 NEW X,Y,Z
- SET Z=+$GET(IBA)
- +4 FOR
- SET X=$GET(^DGPM(Z,0))
- SET Z=$PIECE(X,"^",14)
- SET Y=$PIECE(X,"^",21)
- if Y=""
- QUIT
- SET Z=Y
- +5 QUIT Z