source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCU71.m@ 1259

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

initial load of WorldVistAEHR

File size: 5.0 KB
Line 
1IBCU71 ;ALB/AAS - INTERCEPT SCREEN INPUT OF PROCEDURE CODES ; 29-OCT-91
2 ;;2.0;INTEGRATED BILLING;**41,60,91,106,125,138,210,245,349**;21-MAR-94;Build 46
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;MAP TO DGCRU71
6 ;
7ADDCPT ; - store cpt codes in visits file
8 Q:$D(DGCPT)'>9
9 N DA,DIC,DR,DIE,DIRUT,DUOUT,DTOUT,DIROUT,VADM
10 S DIR(0)="Y",DIR("A")="OK to add CPT codes to Visits file",DIR("B")="Y" D ^DIR K DIR Q:'Y!$D(DIRUT)
11 N IBPKG,IBCLIN,IBVDATE,IBPROC,IBK,IBCOUNT,IBRESULT,IBOTH
12 S IBPKG=$O(^DIC(9.4,"C","IB",0)) Q:'IBPKG
13 W !!,"Adding Procedures to PCE..."
14 S IBCLIN=0 F S IBCLIN=$O(DGCPT(IBCLIN)) Q:'IBCLIN D
15 .;
16 .K ^TMP("IBPXAPI",$J)
17 .;
18 .; - set up encounter data
19 .S IBVDATE=DGPROCDT D VISDT
20 .S ^TMP("IBPXAPI",$J,"ENCOUNTER",1,"ENC D/T")=IBVDATE,^("PATIENT")=DFN,^("HOS LOC")=IBCLIN,^("SERVICE CATEGORY")="X",^("ENCOUNTER TYPE")="A"
21 .;
22 .; - set up procedure and diagnosis data
23 .S IBK=0,IBPROC=0 F S IBPROC=$O(DGCPT(IBCLIN,IBPROC)) Q:'IBPROC D
24 ..S IBOTH="" F S IBOTH=$O(DGCPT(IBCLIN,IBPROC,IBOTH)) Q:IBOTH="" D
25 ...S IBK=IBK+1
26 ...;
27 ...; - load first procedure diagnosis as visit diagnosis
28 ...I +$P(IBOTH,U,2) S ^TMP("IBPXAPI",$J,"DX/PL",IBK,"DIAGNOSIS")=+$P(IBOTH,U,2)
29 ...;
30 ...; - count number of times procedure performed
31 ...S (X,IBCOUNT)=0 F S X=$O(DGCPT(IBCLIN,IBPROC,IBOTH,X)) Q:'X S IBCOUNT=IBCOUNT+1
32 ...;
33 ...; - load procedure information
34 ...S ^TMP("IBPXAPI",$J,"PROCEDURE",IBK,"PROCEDURE")=IBPROC,^("QTY")=IBCOUNT,^("EVENT D/T")=IBVDATE
35 ...I +$P(IBOTH,U,1) S ^TMP("IBPXAPI",$J,"PROCEDURE",IBK,"ENC PROVIDER")=+$P(IBOTH,U,1)
36 ...I +$P(IBOTH,U,3) S ^TMP("IBPXAPI",$J,"PROCEDURE",IBK,"MODIFIERS",$P($$MOD^ICPTMOD(+$P(IBOTH,U,3),"I"),U,2))=""
37 .;
38 .; - call the PCE interface
39 .Q:'$D(^TMP("IBPXAPI",$J,"PROCEDURE"))
40 .;
41 .S IBRESULT=$$DATA2PCE^PXAPI("^TMP(""IBPXAPI"",$J)",IBPKG,"IB DATA",,DUZ,0)
42 .W !," Procedures in ",$P(^SC(IBCLIN,0),"^")," "
43 .I IBRESULT>0 W "were added okay." Q
44 .W "were not added - error code is ",IBRESULT
45 ;
46 K ^TMP("IBPXAPI",$J)
47 Q
48 ;
49 ;
50DISPDX ; - display diagnosis codes available for associated dx (CMS-1500) NO LONGER USED?
51 N I,J,X,IBDX,IBDXL,IBDATE
52 S IBDATE=$$BDATE^IBACSV(IBIFN)
53 F I=1:1:4 S IBDX=$P($G(^DGCR(399,IBIFN,"C")),"^",(I+13)),X=$$ICD9^IBACSV(+IBDX,IBDATE) I X'="" S IBDXL(I)=IBDX_"^"_X
54 I '$D(IBDXL) W !!,"Bill has no ICD DIAGNOSIS." Q
55 W !!,?24,"<<<ASSOCIATED ICD-9 DIAGNOSIS>>>",!!
56 F I=1,2 W ! S X=0 F J=0,2 I $D(IBDXL(I+J)) S IBDX=IBDXL(I+J) D S X=40
57 . W ?X," ",$P(IBDX,"^",2),?(X+13),$E($P(IBDX,"^",4),1,28)
58 W !
59 Q
60 ;
61SCREEN(X,Y) ; -- screen logic for active procs or surgeries - OBSOLETE
62 ; -- input x = date to check, y = procedure
63 ; -- output 0 if not active for billing or amb proc on date, 1 if either active
64 ;
65 Q 0
66 ;
67VISDT ; Find the actual encounter for the visit; update visit date/time
68 ; input DGPROCDT, DFN, IBCLIN
69 N IBD,IBF,IBOEN,IBEVT,IBVAL,IBCBK,IBFILTER
70 S IBF=0,IBD=DGPROCDT-.1
71 S IBVAL("DFN")=DFN,IBVAL("BDT")=DGPROCDT-.1,IBVAL("EDT")=DGPROCDT\1_".99"
72 S IBFILTER=""
73 S IBCBK="I IBCLIN=$P(Y0,U,4) S IBVDATE=+Y0,SDSTOP=1"
74 D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1)
75 Q
76 ;
77PRCDT(IBIFN,ARR) ; return array of bill's procedures in date then code order
78 ; returns ARR(DATE, NAME, CPIFN) = 399.0304 node
79 N IBI,IBX,IBNAME K ARR
80 S IBI=0 F S IBI=$O(^DGCR(399,+$G(IBIFN),"CP",IBI)) Q:'IBI D
81 . S IBX=$G(^DGCR(399,IBIFN,"CP",IBI,0))
82 . S IBNAME=$P($$PRCNM^IBCSCH1($P(IBX,U,1)),U,1)_" "
83 . S ARR($P(IBX,U,2),IBNAME,IBI)=IBX
84 Q
85 ;
86PRCDIV(IBIFN) ; change Bills Default Division (399,.22) to reflect care provided
87 ; - set Bill Division to the first Procedures Division (399,304,5), if defined
88 ; - or else if bill is an inpatient bill then get the Division of the Ward the patient was Admitted to
89 ; return null if no change or 'new division ifn^message'
90 ;
91 N IB0,IBCPT,IBPDIV,IBWRD,IBX,DIC,DIE,DA,DR,X,Y S IBX="",IBPDIV=0
92 S IB0=$G(^DGCR(399,+$G(IBIFN),0))
93 ;
94 I +$G(IBIFN) S IBCPT=$O(^DGCR(399,IBIFN,"CP",0)) I +IBCPT D ; if CPT division defined, use it
95 . S IBCPT=$G(^DGCR(399,IBIFN,"CP",IBCPT,0)) S IBPDIV=+$P(IBCPT,U,6)
96 ;
97 I 'IBPDIV,+$P(IB0,U,8) D ; for inpatient, get Ward Division
98 . S IBWRD=$G(^DGPT(+$P(IB0,U,8),535,1,0)) S IBPDIV=+$P($G(^DIC(42,+$P(IBWRD,U,6),0)),U,11)
99 ;
100 I +IBPDIV,+$P(IB0,U,22)'=+IBPDIV D
101 . S DIE="^DGCR(399,",DA=IBIFN,DR=".22////"_+IBPDIV D ^DIE K DIE,DR,DA,X,Y
102 . S IBX=+IBPDIV_"^Bill Division Changed to "_$P($G(^DG(40.8,+IBPDIV,0)),U,1)
103 Q IBX
104 ;
105DVTYP(IBIFN) ; reset Bill Charge Type (399, .27) based on Bill Division (399, .22)
106 ; if bill division is type 3 - Freestanding then reset Charge Type to 2 - Professional
107 ; with RC 2.0+ Type 3 sites have only professional charges, start date of bill must be on/after beginning of RC 2.0
108 N IB0,IBDV,IBCHGTYP,IBDVTYP,DIC,DIE,DA,DR,X,Y
109 S IB0=$G(^DGCR(399,+$G(IBIFN),0)),IBDV=$P(IB0,U,22),IBCHGTYP=$P(IB0,U,27)
110 I +$G(^DGCR(399,+$G(IBIFN),"U"))<$$VERSDT^IBCRU8(2) G DVTYPQ
111 I +IBDV,+IBCHGTYP S IBDVTYP=$$RCDV^IBCRU8(+IBDV) I +$P(IBDVTYP,U,3)=3,IBCHGTYP'=2 D
112 . S DIE="^DGCR(399,",DA=IBIFN,DR=".27////"_2 D ^DIE K DIE,DR,DA,X,Y
113 . S IBCHGTYP="2^Bill Charge Type Changed to Professional"
114DVTYPQ Q IBCHGTYP
Note: See TracBrowser for help on using the repository browser.