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

IBCU7U.m

Go to the documentation of this file.
  1. IBCU7U ;ALB/ARH - BILL PROCEDURE UTILITIES ; 10-OCT-03
  1. ;;2.0;INTEGRATED BILLING;**245**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; basic bill procedure utilities
  1. ;
  1. DELCPT(IBIFN,OLDDA) ; delete a CPT code from a bill
  1. ; Input: OLDDA = ifn of cpt in bill cpt multiple to be deleted
  1. N DA,DIK,DIC,DIE,X,Y,IBFND S IBFND=0,DA(1)=+$G(IBIFN),DA=+$G(OLDDA)
  1. I $D(^DGCR(399,DA(1),"CP",DA,0)) S DIK="^DGCR(399,"_DA(1)_",""CP""," D ^DIK S IBFND=1
  1. Q IBFND
  1. ;
  1. EDITCPT(IBIFN,OLDDA,NEWCPT) ; replace a CPT code on the bill with another CPT code
  1. ; Input: OLDDA = ifn of cpt in bill cpt multiple to be replaced
  1. ; NEWCPT = ifn of cpt code to be added
  1. N DA,DR,DIE,DIC,IBFND,X,Y S IBFND=0,DA(1)=+$G(IBIFN),DA=+$G(OLDDA),NEWCPT=+$G(NEWCPT)
  1. I NEWCPT,$D(^DGCR(399,DA(1),"CP",DA,0)) S DIE="^DGCR(399,"_DA(1)_",""CP"",",DR=".01///`"_NEWCPT D ^DIE S IBFND=1
  1. Q IBFND
  1. ;
  1. COPYCPT(IBIFN,OLDDA,NEWCPT) ; add a new CPT and populate date fields with data from an existing bill cpt
  1. ; Input: OLDDA = ifn of cpt in bill cpt multiple to be copied
  1. ; NEWCPT = ifn of cpt code to be added
  1. N DLAYGO,DIC,DIE,DA,DR,DD,DO,IBNEWDA,IBODA,IBNDA,IBXDA,IBSFILE,IBX,IBY,IBOLD,IBNEW,IBFND,X,Y S IBFND=0
  1. ;
  1. I '$D(^DGCR(399,+$G(IBIFN),"CP",+$G(OLDDA),0)) G COPYCPQ
  1. I '$G(NEWCPT) G COPYCPQ
  1. ;
  1. ; add new procedure entry to bill
  1. S DLAYGO=399,DA(1)=IBIFN,DIC="^DGCR(399,"_DA(1)_",""CP"",",DIC(0)="L",X=+NEWCPT_";ICPT(" K DD,DO D FILE^DICN K DO,DD,DIC,DIE
  1. S (DA,IBNEWDA,IBFND)=+Y I IBNEWDA<1 S IBFND=0 G COPYCPQ
  1. ;
  1. ; copy data from existing procedure to new procedure on bill
  1. S IBODA=OLDDA_","_IBIFN_","
  1. S IBNDA=IBNEWDA_","_IBIFN_","
  1. D GETS^DIQ(399.0304,IBODA,"*","IN","IBOLD")
  1. S IBSFILE=0 F S IBSFILE=$O(IBOLD(IBSFILE)) Q:'IBSFILE D
  1. . S IBXDA="" F S IBXDA=$O(IBOLD(IBSFILE,IBXDA)) Q:IBXDA="" D
  1. .. S IBX=0 F S IBX=$O(IBOLD(IBSFILE,IBXDA,IBX)) Q:'IBX D
  1. ... I IBXDA=IBODA,",.01,2,3,4,7,14,20,"[(","_IBX_",") Q
  1. ... S IBNEW(IBSFILE,IBNDA,IBX)=IBOLD(IBSFILE,IBXDA,IBX,"I")
  1. I $O(IBNEW(0)) D FILE^DIE("","IBNEW") K DA,DR,DA,DO,DIE,DIC
  1. ;
  1. ; copy modifiers from existing procedure to new procedure on bill
  1. S IBX=0 F S IBX=$O(^DGCR(399,IBIFN,"CP",OLDDA,"MOD",IBX)) Q:'IBX D
  1. . S IBY=$G(^DGCR(399,IBIFN,"CP",OLDDA,"MOD",IBX,0)) Q:IBY=""
  1. . S:'$D(^DGCR(399,IBIFN,"CP",IBNEWDA,"MOD")) DIC("P")=$$GETSPEC^IBEFUNC(399.0304,16)
  1. . S DIC(0)="L",DIC="^DGCR(399,"_IBIFN_",""CP"","_+IBNEWDA_",""MOD"",",DLAYGO=399.30416
  1. . S DA(2)=IBIFN,DA(1)=IBNEWDA,X=+IBY,DIC("DR")=".02////"_$P(IBY,U,2) D FILE^DICN K DIC,DO,DD
  1. ;
  1. COPYCPQ Q IBFND
  1. ;
  1. ADDCPT(IBIFN,SDLN) ; add a new CPT code to a bill and populate it's data based on clinical data
  1. ; Input: SDLN - data line from ^UTILITY($J,"CPT-CNT" created in VST^IBCCPT
  1. ; ^utility($j,cpt-cnt,count)=code^date^on bill^is BASC^divis^nb^nb mess^provider^clinic^mod,mod^Opt Enc Ptr
  1. N DLAYGO,DIC,DIE,DA,DR,DD,DO,DINUM,IBNEWDA,IBFND,X,Y S IBFND=0
  1. ;
  1. I '$D(^DGCR(399,+$G(IBIFN),0)) G ADDCPTQ
  1. I '$G(SDLN) G ADDCPTQ
  1. I +$P(SDLN,U,6) G ADDCPTQ
  1. ;
  1. I '$D(^DGCR(399,IBIFN,"CP")) S DIC("P")=$$GETSPEC^IBEFUNC(399,304)
  1. S DLAYGO=399,DA(1)=IBIFN,DIC="^DGCR(399,"_DA(1)_",""CP"",",DIC(0)="L",X=+SDLN_";ICPT(" K DD,DO D FILE^DICN K DO,DD,DIC("P")
  1. S (DA,IBNEWDA,IBFND)=+Y I IBNEWDA<1 S IBFND=0 G ADDCPTQ
  1. ;
  1. S DR="1////"_$P(SDLN,U,2)_$S(+$P(SDLN,U,8):";18////"_+$P(SDLN,U,8),1:"")
  1. S DR=DR_$S(+$P(SDLN,U,9):";6////"_+$P(SDLN,U,9),1:"")_$S(+$P(SDLN,U,5):";5////"_+$P(SDLN,U,5),1:"")
  1. S DR=DR_$S(+$P(SDLN,U,11):";20////"_+$P(SDLN,U,11),1:"")
  1. S DIE=DIC,DA=+IBNEWDA D ^DIE K DIE,DIC,DA,DINUM,DO,DD
  1. ;
  1. I $P(SDLN,U,10) D ADDMOD^IBCCPT(IBIFN,IBNEWDA,$P(SDLN,U,10)) ;Modifiers
  1. ;
  1. ADDCPTQ Q IBFND
  1. ;
  1. GETSD(IBIFN) ; get the procedures from the clinical data covered by the bill
  1. ; Output: ^UTILITY($J,"CPT-CNT",X)= ... (from VST^IBCCPT)
  1. ; ^UTILITY($J,"CPT-CLN",CPT,EVDT)= ...
  1. N SDCNT,SDQDATA,SDQUERY,V,X,IBQUERY,IBOPV1,IBOPV2,DGCNT,DFN,IBX,IBY K ^UTILITY($J)
  1. S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) Q:'DFN
  1. D VST^IBCCPT(.IBQUERY)
  1. S IBX=0 F S IBX=$O(^UTILITY($J,"CPT-CNT",IBX)) Q:'IBX D
  1. . S IBY=^UTILITY($J,"CPT-CNT",IBX)
  1. . S ^UTILITY($J,"CPT-CLN",$P(IBY,U,1),$P(IBY,U,2))=IBY
  1. Q