- 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
