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