- 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 Feb 18, 2025@23:47:25 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 ;