source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCU7U.m@ 1806

Last change on this file since 1806 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1IBCU7U ;ALB/ARH - BILL PROCEDURE UTILITIES ; 10-OCT-03
2 ;;2.0;INTEGRATED BILLING;**245**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; basic bill procedure utilities
6 ;
7DELCPT(IBIFN,OLDDA) ; delete a CPT code from a bill
8 ; Input: OLDDA = ifn of cpt in bill cpt multiple to be deleted
9 N DA,DIK,DIC,DIE,X,Y,IBFND S IBFND=0,DA(1)=+$G(IBIFN),DA=+$G(OLDDA)
10 I $D(^DGCR(399,DA(1),"CP",DA,0)) S DIK="^DGCR(399,"_DA(1)_",""CP""," D ^DIK S IBFND=1
11 Q IBFND
12 ;
13EDITCPT(IBIFN,OLDDA,NEWCPT) ; replace a CPT code on the bill with another CPT code
14 ; Input: OLDDA = ifn of cpt in bill cpt multiple to be replaced
15 ; NEWCPT = ifn of cpt code to be added
16 N DA,DR,DIE,DIC,IBFND,X,Y S IBFND=0,DA(1)=+$G(IBIFN),DA=+$G(OLDDA),NEWCPT=+$G(NEWCPT)
17 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
18 Q IBFND
19 ;
20COPYCPT(IBIFN,OLDDA,NEWCPT) ; add a new CPT and populate date fields with data from an existing bill cpt
21 ; Input: OLDDA = ifn of cpt in bill cpt multiple to be copied
22 ; NEWCPT = ifn of cpt code to be added
23 N DLAYGO,DIC,DIE,DA,DR,DD,DO,IBNEWDA,IBODA,IBNDA,IBXDA,IBSFILE,IBX,IBY,IBOLD,IBNEW,IBFND,X,Y S IBFND=0
24 ;
25 I '$D(^DGCR(399,+$G(IBIFN),"CP",+$G(OLDDA),0)) G COPYCPQ
26 I '$G(NEWCPT) G COPYCPQ
27 ;
28 ; add new procedure entry to bill
29 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
30 S (DA,IBNEWDA,IBFND)=+Y I IBNEWDA<1 S IBFND=0 G COPYCPQ
31 ;
32 ; copy data from existing procedure to new procedure on bill
33 S IBODA=OLDDA_","_IBIFN_","
34 S IBNDA=IBNEWDA_","_IBIFN_","
35 D GETS^DIQ(399.0304,IBODA,"*","IN","IBOLD")
36 S IBSFILE=0 F S IBSFILE=$O(IBOLD(IBSFILE)) Q:'IBSFILE D
37 . S IBXDA="" F S IBXDA=$O(IBOLD(IBSFILE,IBXDA)) Q:IBXDA="" D
38 .. S IBX=0 F S IBX=$O(IBOLD(IBSFILE,IBXDA,IBX)) Q:'IBX D
39 ... I IBXDA=IBODA,",.01,2,3,4,7,14,20,"[(","_IBX_",") Q
40 ... S IBNEW(IBSFILE,IBNDA,IBX)=IBOLD(IBSFILE,IBXDA,IBX,"I")
41 I $O(IBNEW(0)) D FILE^DIE("","IBNEW") K DA,DR,DA,DO,DIE,DIC
42 ;
43 ; copy modifiers from existing procedure to new procedure on bill
44 S IBX=0 F S IBX=$O(^DGCR(399,IBIFN,"CP",OLDDA,"MOD",IBX)) Q:'IBX D
45 . S IBY=$G(^DGCR(399,IBIFN,"CP",OLDDA,"MOD",IBX,0)) Q:IBY=""
46 . S:'$D(^DGCR(399,IBIFN,"CP",IBNEWDA,"MOD")) DIC("P")=$$GETSPEC^IBEFUNC(399.0304,16)
47 . S DIC(0)="L",DIC="^DGCR(399,"_IBIFN_",""CP"","_+IBNEWDA_",""MOD"",",DLAYGO=399.30416
48 . S DA(2)=IBIFN,DA(1)=IBNEWDA,X=+IBY,DIC("DR")=".02////"_$P(IBY,U,2) D FILE^DICN K DIC,DO,DD
49 ;
50COPYCPQ Q IBFND
51 ;
52ADDCPT(IBIFN,SDLN) ; add a new CPT code to a bill and populate it's data based on clinical data
53 ; Input: SDLN - data line from ^UTILITY($J,"CPT-CNT" created in VST^IBCCPT
54 ; ^utility($j,cpt-cnt,count)=code^date^on bill^is BASC^divis^nb^nb mess^provider^clinic^mod,mod^Opt Enc Ptr
55 N DLAYGO,DIC,DIE,DA,DR,DD,DO,DINUM,IBNEWDA,IBFND,X,Y S IBFND=0
56 ;
57 I '$D(^DGCR(399,+$G(IBIFN),0)) G ADDCPTQ
58 I '$G(SDLN) G ADDCPTQ
59 I +$P(SDLN,U,6) G ADDCPTQ
60 ;
61 I '$D(^DGCR(399,IBIFN,"CP")) S DIC("P")=$$GETSPEC^IBEFUNC(399,304)
62 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")
63 S (DA,IBNEWDA,IBFND)=+Y I IBNEWDA<1 S IBFND=0 G ADDCPTQ
64 ;
65 S DR="1////"_$P(SDLN,U,2)_$S(+$P(SDLN,U,8):";18////"_+$P(SDLN,U,8),1:"")
66 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:"")
67 S DR=DR_$S(+$P(SDLN,U,11):";20////"_+$P(SDLN,U,11),1:"")
68 S DIE=DIC,DA=+IBNEWDA D ^DIE K DIE,DIC,DA,DINUM,DO,DD
69 ;
70 I $P(SDLN,U,10) D ADDMOD^IBCCPT(IBIFN,IBNEWDA,$P(SDLN,U,10)) ;Modifiers
71 ;
72ADDCPTQ Q IBFND
73 ;
74GETSD(IBIFN) ; get the procedures from the clinical data covered by the bill
75 ; Output: ^UTILITY($J,"CPT-CNT",X)= ... (from VST^IBCCPT)
76 ; ^UTILITY($J,"CPT-CLN",CPT,EVDT)= ...
77 N SDCNT,SDQDATA,SDQUERY,V,X,IBQUERY,IBOPV1,IBOPV2,DGCNT,DFN,IBX,IBY K ^UTILITY($J)
78 S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) Q:'DFN
79 D VST^IBCCPT(.IBQUERY)
80 S IBX=0 F S IBX=$O(^UTILITY($J,"CPT-CNT",IBX)) Q:'IBX D
81 . S IBY=^UTILITY($J,"CPT-CNT",IBX)
82 . S ^UTILITY($J,"CPT-CLN",$P(IBY,U,1),$P(IBY,U,2))=IBY
83 Q
Note: See TracBrowser for help on using the repository browser.