IBEFUNC ;ALB/RLW - EXTRINSIC FUNCTION ; 12-JUN-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
ETXT(X) ; -- output error message text from 350.8
; -- input error message code
N Y S Y=X
I X="" G ETXTQ
S Y=$P($G(^IBE(350.8,+$O(^IBE(350.8,"AC",X,0)),0)),"^",2)
ETXTQ Q Y
;
IGN(X,Y) ; ignore means test? for appointment type on dates
; -- input x = mas appointment type
; y = date of appointment
; output = true if this appointment type should not be billed for
; Cat C Means test billing (352.1,.04) for given date
;
I '$G(X)!('$G(Y)) Q 1
Q +$P($G(^IBE(352.1,+$O(^(+$O(^IBE(352.1,"AIVDT",+X,-(Y+.1))),0)),0)),"^",4)
;
DSP(X,Y) ; display on input screen?
; -- input X = mas appointment type (P409.1)
; Y = date
; output = true if appointment type X (352.1,.02) should be displayed as a
; potential billable visit (352.1,.06) on the given date Y (352.1,.03)
;
I '$G(X)!('$G(Y)) Q 0
Q +$P($G(^IBE(352.1,+$O(^(+$O(^IBE(352.1,"AIVDT",+X,-(Y+.1))),0)),0)),"^",6)
;
RPT(X,Y) ; print on report?
; -- input X = mas appointment type (P409.1)
; Y = date
; output = true if appointment type X (352.1,.02) should be printed on 'Vets w/ Ins and Opt
; Visits' report (352.1,.05) on the given date Y (352.1,.06)
;
I '$G(X)!('$G(Y)) Q 0
Q +$P($G(^IBE(352.1,+$O(^(+$O(^IBE(352.1,"AIVDT",+X,-(Y+.1))),0)),0)),"^",5)
;
NBDIS(X,Y) ; Is this disposition non-billable?
; -- input X = disposition (P37)
; Y = date of appointment
; output = true (1) if this disposition should be ignored for
; Means test billing (352.2,.03) for the given date
;
I '$G(X)!('$G(Y)) Q 0
Q +$P($G(^IBE(352.2,+$O(^(+$O(^IBE(352.2,"AIVDT",+X,-(Y+.1))),0)),0)),"^",3)
;
NBCSC(X,Y) ; Is this clinic stop code non-billable?
; -- input X = clinic stop code (P40.7)
; Y = date of appointment
; output = true (1) if this clinic stop code should be ignored for
; Means test billing (352.3,.03) for the given date
;
I '$G(X)!('$G(Y)) Q 0
Q +$P($G(^IBE(352.3,+$O(^(+$O(^IBE(352.3,"AIVDT",+X,-(Y+.1))),0)),0)),"^",3)
;
NBCL(X,Y) ; Is this clinic non-billable?
; -- input X = clinic (P44)
; Y = date of appointment
; output = true (1) if this clinic should be ignored for
; Means test billing (352.4,.03) for the given date
;
I '$G(X)!('$G(Y)) Q 0
Q +$P($G(^IBE(352.4,+$O(^(+$O(^IBE(352.4,"AIVDT",+X,-(Y+.1))),0)),0)),"^",3)
;
PT(DFN) ;returns (patient name^long patient id^short patient id) or null if not found
N X S X="" I $D(DFN) S X=$G(^DPT(+DFN,0)) I X'="" S X=$P(X,"^",1)_"^"_$P($G(^DPT(DFN,.36)),"^",3,4)
Q X
;
EXSET(X,D0,D1) ;returns external value of a set in file D0, field D1
N Y,Z S Y="" I $G(X)'="",+$G(D0),+$G(D1) S Z=$G(^DD(+D0,+D1,0)) I $P(Z,U,2)["S" S X=X_":",Y=$P($P(Z,X,2),";",1)
; ***** S Y=X,C=$P(^DD(+D0,+D1,0),"^",2) D Y^DIQ K C ******
Q Y
;
BABCSC(DFN,IBDT) ; -- is there any billable stop codes in the encounter file for patient
; -- Input dfn = patient,
; ibdt = date
; output = 1 if any billable stop on date OR 0 if none
;
N IBX,IBOE,IBOEDATA,IBY S IBX=0
I '$G(DFN)!('$G(IBDT)) G BABQ
S IBY=IBDT\1-.00001 F S IBY=$O(^SCE("ADFN",DFN,IBY)) Q:'IBY!(IBY>(IBDT+.24)) D Q:IBX
.S IBOE=$O(^SCE("ADFN",DFN,IBY,0))
.Q:'IBOE
.S IBOEDATA=$G(^SCE(IBOE,0))
.I $P(IBOEDATA,"^",3),$P(IBOEDATA,"^",12)=2,'$$NBCSC($P(IBOEDATA,"^",3),IBY) S IBX=1
.Q
BABQ Q IBX
IBEFUNC ;ALB/RLW - EXTRINSIC FUNCTION ; 12-JUN-92
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
ETXT(X) ; -- output error message text from 350.8
+1 ; -- input error message code
+2 NEW Y
SET Y=X
+3 IF X=""
GOTO ETXTQ
+4 SET Y=$PIECE($GET(^IBE(350.8,+$ORDER(^IBE(350.8,"AC",X,0)),0)),"^",2)
ETXTQ QUIT Y
+1 ;
IGN(X,Y) ; ignore means test? for appointment type on dates
+1 ; -- input x = mas appointment type
+2 ; y = date of appointment
+3 ; output = true if this appointment type should not be billed for
+4 ; Cat C Means test billing (352.1,.04) for given date
+5 ;
+6 IF '$GET(X)!('$GET(Y))
QUIT 1
+7 QUIT +$PIECE($GET(^IBE(352.1,+$ORDER(^(+$ORDER(^IBE(352.1,"AIVDT",+X,-(Y+.1))),0)),0)),"^",4)
+8 ;
DSP(X,Y) ; display on input screen?
+1 ; -- input X = mas appointment type (P409.1)
+2 ; Y = date
+3 ; output = true if appointment type X (352.1,.02) should be displayed as a
+4 ; potential billable visit (352.1,.06) on the given date Y (352.1,.03)
+5 ;
+6 IF '$GET(X)!('$GET(Y))
QUIT 0
+7 QUIT +$PIECE($GET(^IBE(352.1,+$ORDER(^(+$ORDER(^IBE(352.1,"AIVDT",+X,-(Y+.1))),0)),0)),"^",6)
+8 ;
RPT(X,Y) ; print on report?
+1 ; -- input X = mas appointment type (P409.1)
+2 ; Y = date
+3 ; output = true if appointment type X (352.1,.02) should be printed on 'Vets w/ Ins and Opt
+4 ; Visits' report (352.1,.05) on the given date Y (352.1,.06)
+5 ;
+6 IF '$GET(X)!('$GET(Y))
QUIT 0
+7 QUIT +$PIECE($GET(^IBE(352.1,+$ORDER(^(+$ORDER(^IBE(352.1,"AIVDT",+X,-(Y+.1))),0)),0)),"^",5)
+8 ;
NBDIS(X,Y) ; Is this disposition non-billable?
+1 ; -- input X = disposition (P37)
+2 ; Y = date of appointment
+3 ; output = true (1) if this disposition should be ignored for
+4 ; Means test billing (352.2,.03) for the given date
+5 ;
+6 IF '$GET(X)!('$GET(Y))
QUIT 0
+7 QUIT +$PIECE($GET(^IBE(352.2,+$ORDER(^(+$ORDER(^IBE(352.2,"AIVDT",+X,-(Y+.1))),0)),0)),"^",3)
+8 ;
NBCSC(X,Y) ; Is this clinic stop code non-billable?
+1 ; -- input X = clinic stop code (P40.7)
+2 ; Y = date of appointment
+3 ; output = true (1) if this clinic stop code should be ignored for
+4 ; Means test billing (352.3,.03) for the given date
+5 ;
+6 IF '$GET(X)!('$GET(Y))
QUIT 0
+7 QUIT +$PIECE($GET(^IBE(352.3,+$ORDER(^(+$ORDER(^IBE(352.3,"AIVDT",+X,-(Y+.1))),0)),0)),"^",3)
+8 ;
NBCL(X,Y) ; Is this clinic non-billable?
+1 ; -- input X = clinic (P44)
+2 ; Y = date of appointment
+3 ; output = true (1) if this clinic should be ignored for
+4 ; Means test billing (352.4,.03) for the given date
+5 ;
+6 IF '$GET(X)!('$GET(Y))
QUIT 0
+7 QUIT +$PIECE($GET(^IBE(352.4,+$ORDER(^(+$ORDER(^IBE(352.4,"AIVDT",+X,-(Y+.1))),0)),0)),"^",3)
+8 ;
PT(DFN) ;returns (patient name^long patient id^short patient id) or null if not found
+1 NEW X
SET X=""
IF $DATA(DFN)
SET X=$GET(^DPT(+DFN,0))
IF X'=""
SET X=$PIECE(X,"^",1)_"^"_$PIECE($GET(^DPT(DFN,.36)),"^",3,4)
+2 QUIT X
+3 ;
EXSET(X,D0,D1) ;returns external value of a set in file D0, field D1
+1 NEW Y,Z
SET Y=""
IF $GET(X)'=""
IF +$GET(D0)
IF +$GET(D1)
SET Z=$GET(^DD(+D0,+D1,0))
IF $PIECE(Z,U,2)["S"
SET X=X_":"
SET Y=$PIECE($PIECE(Z,X,2),";",1)
+2 ; ***** S Y=X,C=$P(^DD(+D0,+D1,0),"^",2) D Y^DIQ K C ******
+3 QUIT Y
+4 ;
BABCSC(DFN,IBDT) ; -- is there any billable stop codes in the encounter file for patient
+1 ; -- Input dfn = patient,
+2 ; ibdt = date
+3 ; output = 1 if any billable stop on date OR 0 if none
+4 ;
+5 NEW IBX,IBOE,IBOEDATA,IBY
SET IBX=0
+6 IF '$GET(DFN)!('$GET(IBDT))
GOTO BABQ
+7 SET IBY=IBDT\1-.00001
FOR
SET IBY=$ORDER(^SCE("ADFN",DFN,IBY))
IF 'IBY!(IBY>(IBDT+.24))
QUIT
Begin DoDot:1
+8 SET IBOE=$ORDER(^SCE("ADFN",DFN,IBY,0))
+9 IF 'IBOE
QUIT
+10 SET IBOEDATA=$GET(^SCE(IBOE,0))
+11 IF $PIECE(IBOEDATA,"^",3)
IF $PIECE(IBOEDATA,"^",12)=2
IF '$$NBCSC($PIECE(IBOEDATA,"^",3),IBY)
SET IBX=1
+12 QUIT
End DoDot:1
IF IBX
QUIT
BABQ QUIT IBX
