| 1 | IBCCPT ;ALB/LDB - MCCR OUTPATIENT VISITS LISTING CONT. ;29 MAY 90
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**55,62,52,91,106,125,51,148,174,182,245,266,260,339**;21-MAR-94;Build 2
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRCPT
|
|---|
| 6 | ;
|
|---|
| 7 | EN1(IBQUERY,IBHLP) ;
|
|---|
| 8 | K DIR
|
|---|
| 9 | EN D:$D(DIR) HLP W @IOF S DGU=0 K DGCPT,^UTILITY($J) D VST(.IBQUERY)
|
|---|
| 10 | D CHDR,WRNO
|
|---|
| 11 | N ICPTVDT S ICPTVDT=$$BDATE^IBACSV($G(IBIFN)) ; Code Text Version
|
|---|
| 12 | S (DGCNT,DGCNT1)=0 F S DGCNT=$O(^UTILITY($J,"CPT-CNT",DGCNT)) Q:'DGCNT S DGNOD=^(DGCNT),DGCPT=+DGNOD,DGDAT=$P(DGNOD,"^",2),DGBIL=$P(DGNOD,"^",3),DGASC=$P(DGNOD,"^",4),DGDIV=$P(DGNOD,"^",5),DGCNT1=DGCNT1+1 D CPRT I DGU="^" S DGCNT=DGCNT-1 Q
|
|---|
| 13 | I DGU'="^" F Y=$Y:1:IOSL-6 W !
|
|---|
| 14 | OK1 K Y Q:'$D(^UTILITY($J,"CPT-CNT"))!($D(DIR))!($G(IBHLP))
|
|---|
| 15 | OK S DIR(0)="LAO^1:"_DGCNT1_"^K:X[""."" X",DIR("?")="^N DIR D EN1^IBCCPT(.IBQUERY,1)",DIR("A")="SELECT CPT CODE(S) TO INCLUDE IN THIS BILL: "
|
|---|
| 16 | D ^DIR K DIR I 'Y D Q1^IBCOPV1 Q
|
|---|
| 17 | S IBFT=+$P(^DGCR(399,IBIFN,0),"^",19)
|
|---|
| 18 | OK2 W !,"YOU HAVE SELECTED CPT CODE(S) NUMBERED-",$E(Y,1,$L(Y)-1),!,"IS THIS CORRECT" S %=1 D YN^DICN I %=-1 S IBOUT=1 D Q^IBCOPV1 Q
|
|---|
| 19 | I +Y,'% W !,"Respond 'Y'es to include these codes in the bill.",!,"Respond 'N'o to reselect." G OK2
|
|---|
| 20 | I +Y,%=2 G OK
|
|---|
| 21 | ;
|
|---|
| 22 | FILE S DGCPT1=Y,(DGCNT,DGCNT2)=0
|
|---|
| 23 | S DIE="^DGCR(399,",DA=IBIFN,DR=".09///5" D ^DIE K DR,DA,DIE
|
|---|
| 24 | F I9=1:1 S I1=$P(DGCPT1,",",I9) Q:'I1 I $D(^UTILITY($J,"CPT-CNT",I1)) S DGNOD=^(I1),DGNOD("DX")=$G(^(I1,"DX")) D FILE1
|
|---|
| 25 | D Q1^IBCOPV1 Q
|
|---|
| 26 | ;
|
|---|
| 27 | FILE1 ; file procedures, if BASC, only for 1 visit date
|
|---|
| 28 | K DGNOADD S (X,DINUM)=$P(DGNOD,"^",2) D VFILE1^IBCOPV1 K DINUM,X
|
|---|
| 29 | N IBCPTNM S IBCPTNM=$$CPT^ICPTCOD(+DGNOD,+$P(DGNOD,U,2))
|
|---|
| 30 | I $D(DGNOADD) W !?10,"Can't add Amb. Surg. ",$P(IBCPTNM,U,2)," without visit date!" Q ;don't add cpt for date that can't go on bill
|
|---|
| 31 | I IBFT'=2,+$P(DGNOD,"^",4),$$TOMANY($P(DGNOD,"^",2)) W !?10,"Can't add Billable Amb. Surg. ",$P(IBCPTNM,U,2)," when more than one visit date!",*7 Q
|
|---|
| 32 | D DSPPRC(IBCPTNM,DGNOD,$G(DGNOD("DX")))
|
|---|
| 33 | ;
|
|---|
| 34 | S:'$D(^DGCR(399,IBIFN,"CP",0)) DIC("P")=$$GETSPEC^IBEFUNC(399,304)
|
|---|
| 35 | S DLAYGO=399,DA(1)=IBIFN,DIC="^DGCR(399,"_DA(1)_",""CP"",",DIC(0)="L",X=+DGNOD_";ICPT(" K DD,DO D FILE^DICN S (DA,IBPROCP)=+Y K DO,DD,DLAYGO,DIC("P")
|
|---|
| 36 | ;
|
|---|
| 37 | S DR="1///"_$P(DGNOD,"^",2)
|
|---|
| 38 | I +$P(DGNOD,"^",8) S DR=DR_";18///`"_+$P(DGNOD,"^",8)
|
|---|
| 39 | I +$P(DGNOD,"^",9) S DR=DR_";6///`"_+$P(DGNOD,"^",9)
|
|---|
| 40 | I +$P(DGNOD,"^",5) S DR=DR_";5////"_+$P(DGNOD,"^",5)
|
|---|
| 41 | I +$P(DGNOD,"^",11) S DR=DR_";20////"_+$P(DGNOD,"^",11)
|
|---|
| 42 | ;
|
|---|
| 43 | ; file assoc dx if exists from pce
|
|---|
| 44 | D:$G(DGNOD("DX")) ADDDX^IBCCPT1(IBIFN,IBPROCP,DGNOD("DX"),.DR)
|
|---|
| 45 | ;
|
|---|
| 46 | S DIE=DIC D ^DIE
|
|---|
| 47 | D:$P(DGNOD,U,10)'="" ADDMOD(IBIFN,IBPROCP,$P(DGNOD,U,10))
|
|---|
| 48 | ;
|
|---|
| 49 | S DR="16"
|
|---|
| 50 | I '$P(DGNOD,"^",8) S DR=DR_";18"
|
|---|
| 51 | I '$P(DGNOD,"^",9) S DR=DR_";6"
|
|---|
| 52 | I '$P(DGNOD,"^",5) S DR=DR_";5"
|
|---|
| 53 | S:IBFT=2 DR=DR_";8;9;17//NO"
|
|---|
| 54 | S DIE=DIC D ^DIE
|
|---|
| 55 | ;
|
|---|
| 56 | S DR=$$SPCUNIT^IBCU7(IBIFN,IBPROCP) I DR'="" D ^DIE ; miles/minutes/hours
|
|---|
| 57 | ;
|
|---|
| 58 | ; DSS QuadraMed Interface: CPT Sequence and Diagnosis Linkage for Single CPT
|
|---|
| 59 | I $$QMED^IBCU1("DX^VEJDIBE1",IBIFN) D DX^VEJDIBE1(IBIFN,IBPROCP)
|
|---|
| 60 | ;
|
|---|
| 61 | Q:$D(Y)
|
|---|
| 62 | D DX^IBCU72(IBIFN,IBPROCP):IBFT=2
|
|---|
| 63 | I IBFT=2 S X=$$ADDTNL^IBCU7(IBIFN,.DA)
|
|---|
| 64 | L ^DGCR(399,IBIFN):1
|
|---|
| 65 | K DIE,DIC,DR,DA,IBPROCP
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | CPRT D:$Y+6>IOSL SCR Q:DGU="^"
|
|---|
| 69 | N IBCPTNM,IBNBM,IBMODS,J,IBZ,IBDATE
|
|---|
| 70 | S IBDATE=$$BDATE^IBACSV($G(IBIFN))
|
|---|
| 71 | S IBNBM="",IBCPTNM=$$CPT^ICPTCOD(DGCPT,IBDATE) Q:IBCPTNM'>0
|
|---|
| 72 | W !,DGCNT,")",?5,$P(IBCPTNM,U,2),?13,$E($P(IBCPTNM,U,3),1,24),?39,$E($P($G(^SC(+$P(DGNOD,U,9),0)),U,1),1,15),?56,$$FMTE^XLFDT(DGDAT,2)
|
|---|
| 73 | I +DGBIL,+$P($G(DGNOD),U,6) S IBNBM=" *ON BILL/"_$E($P(DGNOD,U,7),1,4)_"*"
|
|---|
| 74 | I IBNBM="",DGBIL S IBNBM=" *ON THIS BILL*"
|
|---|
| 75 | I IBNBM="",+$P($G(DGNOD),U,6) S IBNBM=" "_$E($P(DGNOD,U,7),1,12)
|
|---|
| 76 | W ?64,IBNBM
|
|---|
| 77 | ;
|
|---|
| 78 | S IBMODS=$P($G(DGNOD),U,10) F J=1:1 S IBZ=$P(IBMODS,",",J) Q:IBZ="" S IBZ=$$MOD^ICPTMOD(IBZ,"I",IBDATE) W !,?13,$P(IBZ,U,2),?18,$P(IBZ,U,3)
|
|---|
| 79 | Q
|
|---|
| 80 | CHDR W @IOF,!,?15,"<<CURRENT PROCEDURAL TERMINOLOGY CODES>>",!!,?10,"LISTING FROM VISIT DATES WITH ASSOCIATED CPT CODES",!,?22,"IN OUTPT ENCOUNTERS FILE",!
|
|---|
| 81 | K ^TMP("IBVIS",$J)
|
|---|
| 82 | S L="",$P(L,"=",80)="" W !,L,!,"NO.",?5,"CODE",?13,"SHORT NAME",?39,"CLINIC",?56,"DATE",!,L,! K L
|
|---|
| 83 | Q
|
|---|
| 84 | ADDMOD(IBIFN,IBY,IBMOD) ; Add modifier(s) from PCE procedure to CPT code mult
|
|---|
| 85 | N DIE,DR,DIC,DA,DO,DD,IBS,IBM
|
|---|
| 86 | F IBS=1:1:$L(IBMOD,",") S DA(2)=IBIFN,DA(1)=IBY,X=$O(^DGCR(399,DA(2),"CP",DA(1),"MOD","B",""),-1)+1 S IBM=$P(IBMOD,",",IBS) I IBM'="" D
|
|---|
| 87 | . S:'$D(^DGCR(399,DA(2),"CP",DA(1),"MOD")) DIC("P")=$$GETSPEC^IBEFUNC(399.0304,16)
|
|---|
| 88 | . S DIC(0)="L",DIC="^DGCR(399,"_IBIFN_",""CP"","_IBY_",""MOD"",",DLAYGO=399.30416,DIC("DR")=".02////"_IBM
|
|---|
| 89 | . D FILE^DICN K DIC,DO,DD
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | DSPPRC(CPTNM,NOD,DX) ; display summary of procedure being added
|
|---|
| 93 | N IBI,IBL,IBMODS,IBMOD,IBPRVTYP,IBPRV,IBDATE,IBP,IBDXT
|
|---|
| 94 | I $G(CPTNM)=""!($G(NOD)="") Q
|
|---|
| 95 | S IBMODS=$P(NOD,U,10),IBPRVTYP="",IBPRV=""
|
|---|
| 96 | I +$P(NOD,U,8) S IBPRV=$P($G(^VA(200,+$P(NOD,U,8),0)),U,1),IBPRVTYP=$P($$PRVTYP^IBCRU6(+$P(NOD,U,8)),U,3) S IBL=$S(($L(IBPRVTYP)+$L(IBPRV))>32:"",1:" - ")
|
|---|
| 97 | ;
|
|---|
| 98 | W !!?4,"Adding CPT Procedure: ",$P(CPTNM,U,2),?34,$P(CPTNM,U,3)
|
|---|
| 99 | S IBDATE=$$BDATE^IBACSV($G(IBIFN))
|
|---|
| 100 | I IBMODS'="" F IBI=1:1 S IBMOD=$P(IBMODS,",",IBI) Q:'IBMOD S IBMOD=$$MOD^ICPTMOD(IBMOD,"I",IBDATE) W !,?34,$P(IBMOD,U,2)," - ",$E($P(IBMOD,U,3),1,40)
|
|---|
| 101 | W !,?34,"Visit: ",$$FMTE^XLFDT(+$P(NOD,U,2),2),", ",$E($P($G(^SC(+$P(NOD,U,9),0)),U,1),1,29)
|
|---|
| 102 | I IBPRV'="" W !,?34,"Provider: ",$E(IBPRV,1,35) I IBPRVTYP'="" W:IBL="" !,?44 W IBL,IBPRVTYP
|
|---|
| 103 | I DX F IBP=1:1 Q:'$P(DX,"^",IBP) S IBDXT=$$ICD9^IBACSV($P(DX,"^",IBP),+$P(NOD,U,2)) W !,?34,"Assoc Dx: ",$E($P(IBDXT,"^")_" "_$P(IBDXT,"^",3),1,35)
|
|---|
| 104 | W !
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | VST(IBQUERY) ;Procedures for outpatient visits ... If IBQUERY is defined
|
|---|
| 108 | ; on entry, the QUERY OBJECT defined by this value will be used for
|
|---|
| 109 | ; loop to extract procedures for visits, otherwise, a new QUERY will be opened
|
|---|
| 110 | ; If passed by reference, IBQUERY will be ret'd as the new QUERY ref #
|
|---|
| 111 | S DGCNT=0 I $O(^DGCR(399,IBIFN,"OP",0)) F V=0:0 S V=$O(^DGCR(399,IBIFN,"OP",V)) Q:'V S (IBOPV1,IBOPV2)=V D PROC(.IBQUERY)
|
|---|
| 112 | I $O(^DGCR(399,IBIFN,"OP",0)) K ^TMP("IBVIS",$J) G VSTQ
|
|---|
| 113 | S IBOPV1=$P(^DGCR(399,IBIFN,"U"),"^"),IBOPV2=$P(^("U"),"^",2)
|
|---|
| 114 | D PROC(.IBQUERY) K ^TMP("IBVIS",$J)
|
|---|
| 115 | VSTQ Q
|
|---|
| 116 | ;
|
|---|
| 117 | WRNO W:'$O(^UTILITY($J,"CPT-CNT",0)) !,"NO CPT CODES ON FILE FOR THE ",$S($O(^DGCR(399,IBIFN,"OP",0)):"VISIT DATES ON THIS BILL",1:"PERIOD THAT THIS STATEMENT COVERS")
|
|---|
| 118 | Q
|
|---|
| 119 | SCR Q:DGU="^" I $E(IOST,1,2)["C-",$Y+6>IOSL F Y=$Y:1:IOSL-5 W !
|
|---|
| 120 | I R !,"Press return to continue or ""^"" to exit display ",DGU:DTIME D:DGU'="^" CHDR
|
|---|
| 121 | Q
|
|---|
| 122 | HLP W !!,"Enter a number between 1 and ",DGCNT1," or a range of numbers separated with commas",!,"or dashes, e.g., 1,3,5 or 2-4,8"
|
|---|
| 123 | W !,"The number(s) must appear as a selectable number in the sequential list." R H:5 K H Q
|
|---|
| 124 | CPT S DA(1)=IBIFN,IBCCPTZ=$P(^DGCR(399,DA(1),0),U,9),IBCCPTX=$S($D(^DGCR(399,DA(1),"C"))&IBCCPTZ:1,1:0)
|
|---|
| 125 | K DIK,DGTE,I1 Q
|
|---|
| 126 | ;
|
|---|
| 127 | PROC(IBQUERY) ; -find outpatient procedures, flag if billable
|
|---|
| 128 | ; - ^utility($j,cpt-cnt,count)=code^date^on bill^is BASC^divis^nb^nb mess^provider^clinic^mod,mod^Opt Enc Ptr
|
|---|
| 129 | ; - ^utility($j,cpt-cnt,count,"dx")=assoc dx(1)^assoc dx(2)^assoc dx(3)^assoc dx(4)
|
|---|
| 130 | N IBVAL,IBCBK,IBFILTER
|
|---|
| 131 | S IBVAL("DFN")=DFN,IBVAL("BDT")=IBOPV1,IBVAL("EDT")=(IBOPV2+.99)
|
|---|
| 132 | ; Must be a billable appt type and outpt enctr status of CHECKED OUT
|
|---|
| 133 | S IBFILTER=""
|
|---|
| 134 | S IBCBK="I '$P(Y0,U,6),$P(Y0,U,7),$$DSP^IBEFUNC($P(Y0,U,10),+Y0),'$D(^TMP(""IBVIS"",$J,+$P(Y0,U,5))) S ^TMP(""IBVIS"",$J,+$P(Y0,U,5))="""" D EXTPROC^IBCCPT(IBIFN,Y,Y0,.DGCNT)"
|
|---|
| 135 | D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,0,.IBQUERY) K ^TMP("DIERR",$J)
|
|---|
| 136 | ;
|
|---|
| 137 | Q
|
|---|
| 138 | EXTPROC(IBIFN,IBOE,IBOE0,IBCNT) ; Extract procedures for an encounter
|
|---|
| 139 | ; IBIFN = the ien of the bill
|
|---|
| 140 | ; IBOE0 = 0-node of the outpatient encounter file entry IBOE
|
|---|
| 141 | ; IBCNT extracted entry counter
|
|---|
| 142 | N I2,I7,IBCPT,IBCPTS,IBDIV,IBOED,IBZERR,Z,IBCPTDAT,IBCPTPRV,IBCLINIC,IBZ,IBONBILL,IBMODS,IBARR,IBDT,DFN,IBEX,IBDX,IBOEDP
|
|---|
| 143 | ; make sure i have this variable
|
|---|
| 144 | S:$G(IBOE0)="" IBOE0=$$SCE^IBSDU(+IBOE)
|
|---|
| 145 | D GETCPT^SDOE(IBOE,"IBCPTS","IBZERR")
|
|---|
| 146 | Q:'$O(IBCPTS(0)) ;No procedures for this encounter
|
|---|
| 147 | I '$$BDSRC^IBEFUNC3($P($G(IBOE0),U,5)) Q ; non-billable visit data source
|
|---|
| 148 | S IBOED=$$NBOE^IBCU81(IBOE,IBOE0)
|
|---|
| 149 | S I7=IBOE0\1,IBDIV=$P(IBOE0,U,11)
|
|---|
| 150 | S IBCLINIC="" I +$P(IBOE0,U,4),+$$CLNSCRN^IBCU(I7,+$P(IBOE0,U,4)) S IBCLINIC=+$P(IBOE0,U,4)
|
|---|
| 151 | S I2=0 F S I2=$O(IBCPTS(I2)) Q:'I2 D
|
|---|
| 152 | . S IBCPT=$P(IBCPTS(I2),U)
|
|---|
| 153 | . S IBCPTPRV=$P($G(IBCPTS(I2,12)),U,4)
|
|---|
| 154 | . S IBONBILL=0 S IBZ=0 F S IBZ=$O(^DGCR(399,IBIFN,"CP","B",IBCPT_";ICPT(",IBZ)) Q:'IBZ I $P($G(^DGCR(399,IBIFN,"CP",IBZ,0)),U,2)=I7 S IBONBILL=1
|
|---|
| 155 | . S IBMODS="",IBZ=0 F S IBZ=$O(IBCPTS(I2,1,IBZ)) Q:'IBZ S IBMODS=IBMODS_$S(IBMODS="":"",1:",")_+$G(IBCPTS(I2,1,IBZ,0))
|
|---|
| 156 | . ;
|
|---|
| 157 | . ; look up of a procedure is non-billable and get assoc dx
|
|---|
| 158 | . S IBOEDP=IBOED I IBOEDP="" S IBOEDP=$$NBOEP^IBCCPT1(IBOE0,IBCPT,.IBDX) I IBOEDP'="" S IBOEDP=4_U_IBOEDP
|
|---|
| 159 | . S IBCPTDAT=IBCPT_U_I7_U_IBONBILL_U_0_U_IBDIV_U_$P(IBOEDP,U,1)_U_$P(IBOEDP,U,2)_U_IBCPTPRV_U_IBCLINIC_U_IBMODS_U_IBOE
|
|---|
| 160 | . F Z=1:1:$P(IBCPTS(I2),U,16) S IBCNT=IBCNT+1,^UTILITY($J,"CPT-CNT",IBCNT)=IBCPTDAT,^UTILITY($J,"CPT-CNT",IBCNT,"DX")=$G(IBDX)
|
|---|
| 161 | . K IBDX
|
|---|
| 162 | I $O(IBARR("CPT",0)),'$D(^UTILITY($J,"CPT",+IBOE0,0)) S ^(0)="Y"
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | TOMANY(DATE) ; - returns 1 if more than 1 visit date on bill (for basc)
|
|---|
| 166 | G TOMANYQ:'$D(DATE)
|
|---|
| 167 | S DGVCNT=+$P($G(^DGCR(399,IBIFN,"OP",0)),"^",4)
|
|---|
| 168 | I DGVCNT>1!(DGVCNT=1&('$D(^DGCR(399,IBIFN,"OP",DATE)))) K DGVCNT Q 1
|
|---|
| 169 | TOMANYQ Q 0
|
|---|
| 170 | ;
|
|---|
