Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCU9

IBCU9.m

Go to the documentation of this file.
  1. IBCU9 ;ALB/BI - BILLING UTILITY ROUTINE (CONTINUED) ;01 JUL 2011 11:13
  1. ;;2.0;INTEGRATED BILLING;**447,592**;01-JUL-2011;Build 58
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. CMAEDALL(IBIEN) ; Clear all manually edited flags for a claim.
  1. N IBRCIEN S IBRCIEN=0
  1. F S IBRCIEN=$O(^DGCR(399,IBIEN,"RC",IBRCIEN)) Q:+IBRCIEN=0 D
  1. . D CMAEDIND(IBIEN,IBRCIEN)
  1. Q
  1. ;
  1. CMAEDIND(IBIEN,IBRCIEN) ; Clear individual manually edited flags for a revenue code.
  1. S $P(^DGCR(399,IBIEN,"RC",IBRCIEN,0),U,16)=""
  1. Q
  1. ;
  1. FROMPROC(IBIEN,IBCPIEN,IBFLG) ; Clear individual manually edited flag if procedures match.
  1. I $G(IBIEN)="" Q
  1. I $G(IBCPIEN)="" Q
  1. I $G(IBFLG)="" Q
  1. I IBFLG="E",IBCPIEN=$O(^DGCR(399,IBIEN,"CP",0)) D CMAEDALL(IBIEN) Q
  1. I IBFLG="D",IBCPIEN=$O(^DGCR(399,IBIEN,"CP",0)) D PROC1DEL(IBIEN) Q
  1. N IBRC0,IBRCPRSP
  1. N IBRCIEN S IBRCIEN=0
  1. F S IBRCIEN=$O(^DGCR(399,IBIEN,"RC",IBRCIEN)) Q:+IBRCIEN=0 D
  1. . S IBRC0=$G(^DGCR(399,IBIEN,"RC",IBRCIEN,0)),IBRCPRSP=$P(IBRC0,U,11)
  1. . I IBRCPRSP=IBCPIEN D CMAEDIND(IBIEN,IBRCIEN)
  1. Q
  1. ;
  1. PROC1DEL(IBIEN) ; The first procedure was deleted, determine division change.
  1. N IBCPIEN1,IBCPIEN2
  1. S IBCPIEN1=$O(^DGCR(399,IBIEN,"CP",0)) I IBCPIEN1="" Q
  1. S IBCPIEN2=$O(^DGCR(399,IBIEN,"CP",IBCPIEN1)) I IBCPIEN2="" D CMAEDALL(IBIEN) Q
  1. I $P($G(^DGCR(399,IBIEN,"CP",IBCPIEN1,0)),U,6)'=$P($G(^DGCR(399,IBIEN,"CP",IBCPIEN2,0)),U,6) D CMAEDALL(IBIEN)
  1. Q
  1. ;
  1. ;JWS;IB*2.0*592;US1109 Dental
  1. FTINPUT(Y) ;SCREEN FOR 399, .19 FORM TYPE
  1. N Z
  1. I Y=7,$P($G(^IBE(350.9,1,8)),U,20)=0 Q 0
  1. S Z=$G(^IBE(353,Y,2)) I $P(Z,U,2)="P",$P(Z,U,4) Q 1
  1. Q 0
  1. ;