IBCU1 ;ALB/MRL - BILLING UTILITY ROUTINE (CONTINUED) ;01 JUN 88 12:00
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;MAP TO DGCRU1
;
;procedure doesn't appear to be used (6/4/93), if it is used, what for??
;where would multiple provider numbers comde from? ARH
;BCH ;Blue Cross/Shield Help
W ! S IB01=$P($G(^IBE(350.9,1,1)),"^",6)
I IB01]"" W "CHOOSE FROM",!!?4,"1 - ",$P(IB01,"^",6) F IB00=2,3 I $P(IB01,"^",$S(IB00=2:14,1:15))]"" W !?4,IB00," - ",$P(IB01,"^",$S(IB00=2:14,1:15))
W:IB01']"" "NO BLUE CROSS/SHIELD PROVIDER NUMBERS IDENTIFIED TO SELECT FROM!" W ! W:IB01]"" !,"OR " W "ENTER BLUE CROSS/SHIELD PROVIDER # (BETWEEN 3-13 CHARACTERS)",! K IB00,IB01 Q
;
RCD ;Revenue Code Display
Q:'$D(^DGCR(399,IBIFN,"RC"))
W @IOF,!,"Revenue Code Listing"
S DGIFN=0 F IBI=0:0 S DGIFN=$O(^DGCR(399,IBIFN,"RC",DGIFN)) Q:'DGIFN I $D(^DGCR(399,IBIFN,"RC",DGIFN,0)) S Z=^(0) D DISRC
I $D(DIC(0)) S DIC(0)=DIC(0)_"N"
Q
DISRC W !?4,DGIFN,?8,$P(^DGCR(399.2,+Z,0),"^"),"-",$E($P(^DGCR(399.2,+Z,0),"^",2),1,20),?35,"Units = ",$P(Z,"^",3),?46 S X=$P(Z,"^",2),X2="2$" D COMMA^%DTC W X I $P(Z,"^",5),$D(^DGCR(399.1,$P(Z,"^",5),0)) W ?59,$E($P(^(0),"^"),1,20)
Q
;
ORDNXT(IFN) ;CALLED BY TRIGGER ON (362.3,.02) THAT SETS DX PRINT ORDER (362.3,.03),
;returns the highest print order used on the bill plus 3, returns 3 if no existing print order
;used for the default print order so that dx's can be printed in order of entry without any input by the user,
;3 is added to allow spaces for additions, changes, moves
N X,Y S X="" I $D(^DGCR(399,+$G(IFN),0)) S X=3,Y=0 F S Y=$O(^IBA(362.3,"AO",+IFN,Y)) Q:'Y S X=Y+3
Q X
;
ORDDUP(ORD,DIFN) ;returns true if print order ORD is already defined for a bill (not same entry)
N IBX,IBY S IBY=0
I +$G(ORD) S IBX=$G(^IBA(362.3,+$G(DIFN),0)) I +IBX,+$P(IBX,U,3)'=ORD,$D(^IBA(362.3,"AO",+$P(IBX,U,2),+ORD)) S IBY=1
Q IBY
;
DXDUP(DX,DIFN,IFN) ;returns true if DX is already defined for a bill (not same entry)
;either DIFN or IFN can be passed, both are not needed, DIFN is needed during edit so can reenter the same dx
N IBX,IBY S IBY=0 I +$G(DX),'$G(IFN) S IBX=$G(^IBA(362.3,+$G(DIFN),0)),IFN=+$P(IBX,U,2)
I +$G(DX),$D(^IBA(362.3,"AIFN"_+IFN,+DX)),$O(^IBA(362.3,"AIFN"_+IFN,+DX,0))'=+$G(DIFN) S IBY=1
Q IBY
;
DXBSTAT(DIFN,IFN) ;returns a diagnosis' bill status (either DIFN or IFN can be passed, both are not needed)
N IBX,IBY I '$G(IFN) S IBX=$G(^IBA(362.3,+$G(DIFN),0)),IFN=+$P(IBX,U,2)
S IBY=+$P($G(^DGCR(399,+IFN,0)),U,13)
Q IBY
IBCU1 ;ALB/MRL - BILLING UTILITY ROUTINE (CONTINUED) ;01 JUN 88 12:00
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRU1
+5 ;
+6 ;procedure doesn't appear to be used (6/4/93), if it is used, what for??
+7 ;where would multiple provider numbers comde from? ARH
+8 ;BCH ;Blue Cross/Shield Help
+9 WRITE !
SET IB01=$PIECE($GET(^IBE(350.9,1,1)),"^",6)
+10 IF IB01]""
WRITE "CHOOSE FROM",!!?4,"1 - ",$PIECE(IB01,"^",6)
FOR IB00=2,3
IF $PIECE(IB01,"^",$SELECT(IB00=2:14,1:15))]""
WRITE !?4,IB00," - ",$PIECE(IB01,"^",$SELECT(IB00=2:14,1:15))
+11 IF IB01']""
WRITE "NO BLUE CROSS/SHIELD PROVIDER NUMBERS IDENTIFIED TO SELECT FROM!"
WRITE !
IF IB01]""
WRITE !,"OR "
WRITE "ENTER BLUE CROSS/SHIELD PROVIDER # (BETWEEN 3-13 CHARACTERS)",!
KILL IB00,IB01
QUIT
+12 ;
RCD ;Revenue Code Display
+1 IF '$DATA(^DGCR(399,IBIFN,"RC"))
QUIT
+2 WRITE @IOF,!,"Revenue Code Listing"
+3 SET DGIFN=0
FOR IBI=0:0
SET DGIFN=$ORDER(^DGCR(399,IBIFN,"RC",DGIFN))
IF 'DGIFN
QUIT
IF $DATA(^DGCR(399,IBIFN,"RC",DGIFN,0))
SET Z=^(0)
DO DISRC
+4 IF $DATA(DIC(0))
SET DIC(0)=DIC(0)_"N"
+5 QUIT
DISRC WRITE !?4,DGIFN,?8,$PIECE(^DGCR(399.2,+Z,0),"^"),"-",$EXTRACT($PIECE(^DGCR(399.2,+Z,0),"^",2),1,20),?35,"Units = ",$PIECE(Z,"^",3),?46
SET X=$PIECE(Z,"^",2)
SET X2="2$"
DO COMMA^%DTC
WRITE X
IF $PIECE(Z,"^",5)
IF $DATA(^DGCR(399.1,$PIECE(Z,"^",5),0))
WRITE ?59,$EXTRACT($PIECE(^(0),"^"),1,20)
+1 QUIT
+2 ;
ORDNXT(IFN) ;CALLED BY TRIGGER ON (362.3,.02) THAT SETS DX PRINT ORDER (362.3,.03),
+1 ;returns the highest print order used on the bill plus 3, returns 3 if no existing print order
+2 ;used for the default print order so that dx's can be printed in order of entry without any input by the user,
+3 ;3 is added to allow spaces for additions, changes, moves
+4 NEW X,Y
SET X=""
IF $DATA(^DGCR(399,+$GET(IFN),0))
SET X=3
SET Y=0
FOR
SET Y=$ORDER(^IBA(362.3,"AO",+IFN,Y))
IF 'Y
QUIT
SET X=Y+3
+5 QUIT X
+6 ;
ORDDUP(ORD,DIFN) ;returns true if print order ORD is already defined for a bill (not same entry)
+1 NEW IBX,IBY
SET IBY=0
+2 IF +$GET(ORD)
SET IBX=$GET(^IBA(362.3,+$GET(DIFN),0))
IF +IBX
IF +$PIECE(IBX,U,3)'=ORD
IF $DATA(^IBA(362.3,"AO",+$PIECE(IBX,U,2),+ORD))
SET IBY=1
+3 QUIT IBY
+4 ;
DXDUP(DX,DIFN,IFN) ;returns true if DX is already defined for a bill (not same entry)
+1 ;either DIFN or IFN can be passed, both are not needed, DIFN is needed during edit so can reenter the same dx
+2 NEW IBX,IBY
SET IBY=0
IF +$GET(DX)
IF '$GET(IFN)
SET IBX=$GET(^IBA(362.3,+$GET(DIFN),0))
SET IFN=+$PIECE(IBX,U,2)
+3 IF +$GET(DX)
IF $DATA(^IBA(362.3,"AIFN"_+IFN,+DX))
IF $ORDER(^IBA(362.3,"AIFN"_+IFN,+DX,0))'=+$GET(DIFN)
SET IBY=1
+4 QUIT IBY
+5 ;
DXBSTAT(DIFN,IFN) ;returns a diagnosis' bill status (either DIFN or IFN can be passed, both are not needed)
+1 NEW IBX,IBY
IF '$GET(IFN)
SET IBX=$GET(^IBA(362.3,+$GET(DIFN),0))
SET IFN=+$PIECE(IBX,U,2)
+2 SET IBY=+$PIECE($GET(^DGCR(399,+IFN,0)),U,13)
+3 QUIT IBY
