IBCU9 ;ALB/BI - BILLING UTILITY ROUTINE (CONTINUED) ;01 JUL 2011 11:13
;;2.0;INTEGRATED BILLING;**447,592**;01-JUL-2011;Build 58
;;Per VA Directive 6402, this routine should not be modified.
Q
;
CMAEDALL(IBIEN) ; Clear all manually edited flags for a claim.
N IBRCIEN S IBRCIEN=0
F S IBRCIEN=$O(^DGCR(399,IBIEN,"RC",IBRCIEN)) Q:+IBRCIEN=0 D
. D CMAEDIND(IBIEN,IBRCIEN)
Q
;
CMAEDIND(IBIEN,IBRCIEN) ; Clear individual manually edited flags for a revenue code.
S $P(^DGCR(399,IBIEN,"RC",IBRCIEN,0),U,16)=""
Q
;
FROMPROC(IBIEN,IBCPIEN,IBFLG) ; Clear individual manually edited flag if procedures match.
I $G(IBIEN)="" Q
I $G(IBCPIEN)="" Q
I $G(IBFLG)="" Q
I IBFLG="E",IBCPIEN=$O(^DGCR(399,IBIEN,"CP",0)) D CMAEDALL(IBIEN) Q
I IBFLG="D",IBCPIEN=$O(^DGCR(399,IBIEN,"CP",0)) D PROC1DEL(IBIEN) Q
N IBRC0,IBRCPRSP
N IBRCIEN S IBRCIEN=0
F S IBRCIEN=$O(^DGCR(399,IBIEN,"RC",IBRCIEN)) Q:+IBRCIEN=0 D
. S IBRC0=$G(^DGCR(399,IBIEN,"RC",IBRCIEN,0)),IBRCPRSP=$P(IBRC0,U,11)
. I IBRCPRSP=IBCPIEN D CMAEDIND(IBIEN,IBRCIEN)
Q
;
PROC1DEL(IBIEN) ; The first procedure was deleted, determine division change.
N IBCPIEN1,IBCPIEN2
S IBCPIEN1=$O(^DGCR(399,IBIEN,"CP",0)) I IBCPIEN1="" Q
S IBCPIEN2=$O(^DGCR(399,IBIEN,"CP",IBCPIEN1)) I IBCPIEN2="" D CMAEDALL(IBIEN) Q
I $P($G(^DGCR(399,IBIEN,"CP",IBCPIEN1,0)),U,6)'=$P($G(^DGCR(399,IBIEN,"CP",IBCPIEN2,0)),U,6) D CMAEDALL(IBIEN)
Q
;
;JWS;IB*2.0*592;US1109 Dental
FTINPUT(Y) ;SCREEN FOR 399, .19 FORM TYPE
N Z
I Y=7,$P($G(^IBE(350.9,1,8)),U,20)=0 Q 0
S Z=$G(^IBE(353,Y,2)) I $P(Z,U,2)="P",$P(Z,U,4) Q 1
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCU9 1618 printed Apr 09, 2024@21:26:41 Page 2
IBCU9 ;ALB/BI - BILLING UTILITY ROUTINE (CONTINUED) ;01 JUL 2011 11:13
+1 ;;2.0;INTEGRATED BILLING;**447,592**;01-JUL-2011;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
CMAEDALL(IBIEN) ; Clear all manually edited flags for a claim.
+1 NEW IBRCIEN
SET IBRCIEN=0
+2 FOR
SET IBRCIEN=$ORDER(^DGCR(399,IBIEN,"RC",IBRCIEN))
if +IBRCIEN=0
QUIT
Begin DoDot:1
+3 DO CMAEDIND(IBIEN,IBRCIEN)
End DoDot:1
+4 QUIT
+5 ;
CMAEDIND(IBIEN,IBRCIEN) ; Clear individual manually edited flags for a revenue code.
+1 SET $PIECE(^DGCR(399,IBIEN,"RC",IBRCIEN,0),U,16)=""
+2 QUIT
+3 ;
FROMPROC(IBIEN,IBCPIEN,IBFLG) ; Clear individual manually edited flag if procedures match.
+1 IF $GET(IBIEN)=""
QUIT
+2 IF $GET(IBCPIEN)=""
QUIT
+3 IF $GET(IBFLG)=""
QUIT
+4 IF IBFLG="E"
IF IBCPIEN=$ORDER(^DGCR(399,IBIEN,"CP",0))
DO CMAEDALL(IBIEN)
QUIT
+5 IF IBFLG="D"
IF IBCPIEN=$ORDER(^DGCR(399,IBIEN,"CP",0))
DO PROC1DEL(IBIEN)
QUIT
+6 NEW IBRC0,IBRCPRSP
+7 NEW IBRCIEN
SET IBRCIEN=0
+8 FOR
SET IBRCIEN=$ORDER(^DGCR(399,IBIEN,"RC",IBRCIEN))
if +IBRCIEN=0
QUIT
Begin DoDot:1
+9 SET IBRC0=$GET(^DGCR(399,IBIEN,"RC",IBRCIEN,0))
SET IBRCPRSP=$PIECE(IBRC0,U,11)
+10 IF IBRCPRSP=IBCPIEN
DO CMAEDIND(IBIEN,IBRCIEN)
End DoDot:1
+11 QUIT
+12 ;
PROC1DEL(IBIEN) ; The first procedure was deleted, determine division change.
+1 NEW IBCPIEN1,IBCPIEN2
+2 SET IBCPIEN1=$ORDER(^DGCR(399,IBIEN,"CP",0))
IF IBCPIEN1=""
QUIT
+3 SET IBCPIEN2=$ORDER(^DGCR(399,IBIEN,"CP",IBCPIEN1))
IF IBCPIEN2=""
DO CMAEDALL(IBIEN)
QUIT
+4 IF $PIECE($GET(^DGCR(399,IBIEN,"CP",IBCPIEN1,0)),U,6)'=$PIECE($GET(^DGCR(399,IBIEN,"CP",IBCPIEN2,0)),U,6)
DO CMAEDALL(IBIEN)
+5 QUIT
+6 ;
+7 ;JWS;IB*2.0*592;US1109 Dental
FTINPUT(Y) ;SCREEN FOR 399, .19 FORM TYPE
+1 NEW Z
+2 IF Y=7
IF $PIECE($GET(^IBE(350.9,1,8)),U,20)=0
QUIT 0
+3 SET Z=$GET(^IBE(353,Y,2))
IF $PIECE(Z,U,2)="P"
IF $PIECE(Z,U,4)
QUIT 1
+4 QUIT 0
+5 ;
