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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1IBTRKR41 ;ALB/AAS - CLAIMS TRACKING - ADD/TRACK OUTPATIENT ENCOUNTERS ;13-AUG-93
2 ;;2.0;INTEGRATED BILLING;**43,55,91,132,174,247,260,315,292,312,339**;21-MAR-94;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5OPCHK ; -- check and add rx
6 N Y,Y0
7 N IBSWINFO S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
8 ; IBDT is set from IBTRKR4
9 ; Do NOT PROCESS on VistA if IBDT>=Switch Eff Date ;CCR-930
10 I +IBSWINFO,(IBDT+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
11 ;
12 K IBRMARK
13 I '$D(ZTQUEUED),($G(IBTALK)) W "."
14 ;
15 S IBOEDATA=$$SCE^IBSDU(IBOE),IBOESTAT=$P(IBOEDATA,"^",15)
16 S DFN=$P(IBOEDATA,"^",2)
17 I 'DFN G OPCHKQ
18 I $P(IBOEDATA,"^",5) S IBVSIT=$P(IBOEDATA,"^",5) I '$$BDSRC^IBEFUNC3(IBVSIT) G OPCHKQ ;non-billable data sources
19 ; -- do not allow date/time duplicate claims before Jan. 1, 2006
20 I $O(^IBT(356,"APTY",DFN,IBOETYP,IBDT,0)),IBDT<3060101 G OPCHKQ
21 ;
22 ; -- see if tracking only insured and pt is insured/insured for outpt visits
23 I $P(IBTRKR,"^",3)=1,'$$INSURED^IBCNS1(DFN,IBDT) G OPCHKQ ; patient not insured
24 ;
25 ; -- see if outpatient services are covered
26 I '$$PTCOV^IBCNSU3(DFN,IBDT,"OUTPATIENT",.IBANY) S IBRMARK=$S($G(IBANY):"SERVICE NOT COVERED",1:"NOT INSURED")
27 ;
28 ; -- see if appointment type is billable
29 I '$$RPT^IBEFUNC($P(IBOEDATA,"^",10),+IBOEDATA) S IBRMARK="NON-BILLABLE APPOINTMENT TYPE"
30 ;
31 ; -- check sc status, special conditions etc.
32 I $G(IBRMARK)="" S IBRMARK=$$CL(IBOEDATA)
33 ;
34 ; -- check for non-billable stops or clinic
35 S X=$P(IBOEDATA,"^",4) I X,$$NBCT^IBEFUNC(X,+IBOEDATA) S IBRMARK="NON-BILLABLE CLINIC"
36 S X=$P(IBOEDATA,"^",3) I X,$$NBST^IBEFUNC(X,+IBOEDATA) S IBRMARK="NON-BILLABLE STOP CODE"
37 ;
38 ; -- ok to add to tracking module
39 D OPT^IBTUTL1(DFN,IBOETYP,IBDT,IBOE,IBRMARK,$G(IBVSIT)) I '$D(ZTQUEUED),$G(IBTALK) W "+"
40 I IBRMARK'="" S IBCNT2=IBCNT2+1
41 I IBRMARK="" S IBCNT1=IBCNT1+1
42OPCHKQ K IBANY,IBRMARK,VAEL,VA,IBOEDATA,IBVSIT,DFN,X,Y
43 Q
44 ;
45BULL ; -- send bulletin
46 ;
47 S XMSUB="Outpatient Encounters added to Claims Tracking Complete"
48 S IBT(1)="The process to automatically add Opt Encounters has successfully completed."
49 S IBT(1.1)=""
50 S IBT(2)=" Start Date: "_$$DAT1^IBOUTL(IBTSBDT)
51 S IBT(3)=" End Date: "_$$DAT1^IBOUTL(IBTSEDT)
52 I $D(IBMESS) S IBT(3.1)=IBMESS
53 S IBT(4)=""
54 S IBT(5)=" Total Encounters Checked: "_$G(IBCNT)
55 S IBT(6)=" Total Encounters Added: "_$G(IBCNT1)
56 S IBT(7)=" Total Non-billable Encounters Added: "_$G(IBCNT2)
57 S IBT(8)=""
58 S IBT(9)="*The SC, Agent Orange, Southwest Asia, Ionizing Radiation,"
59 S IBT(10)="Military Sexual Trauma, Head Neck Cancer, Combat Veteran and Project 112/SHAD"
60 S IBT(11)="status visits have been added for insured patients but automatically"
61 S IBT(12)="indicated as not billable."
62 D SEND^IBTRKR31
63BULLQ Q
64 ;
65CL(IBOEDATA,IBR) ; check out classification questions for encounter
66 ; this new check will look at the V POV level then to the Visit level
67 ; as necessary to determine if it relates or not. This will indicate
68 ; if the WHOLE visit is not billable, otherwise it will say it is
69 ; (even if just part is billable).
70 ; call with the zero node of 409.68 in IBOEDATA
71 ; assumes DFN and IBDT defined
72 ; pass in IBR by ref to get values back
73 ;
74 N IBRMARK,IBPCEX,IBCPT,IBARR,IBP,IBDX,IBVRNB,IBENCL
75 S IBRMARK="",IBPCEX=$P(IBOEDATA,"^",5)
76 ;
77 ; look up classification info needed (if any)
78 D CL^SDCO21(DFN,IBDT,"",.IBARR) I '$D(IBARR) G CLQ
79 ;
80 ; if no PCE event use old approach
81 I 'IBPCEX D:$G(IBOE) G CLQ
82 . S IBENCL=$$ENCL^IBAMTS2(IBOE) I IBENCL["1" D ; return 1 in string if true "ao^ir^sc^swa^mst^hnc^cv^shad"
83 . I $P(IBENCL,"^",3) S IBRMARK="SC TREATMENT" Q
84 . I $P(IBENCL,"^",1) S IBRMARK="AGENT ORANGE" Q
85 . I $P(IBENCL,"^",2) S IBRMARK="IONIZING RADIATION" Q
86 . I $P(IBENCL,"^",4) S IBRMARK="SOUTHWEST ASIA" Q
87 . I $P(IBENCL,"^",5) S IBRMARK="MILITARY SEXUAL TRAUMA" Q
88 . I $P(IBENCL,"^",6) S IBRMARK="HEAD/NECK CANCER" Q
89 . I $P(IBENCL,"^",7) S IBRMARK="COMBAT VETERAN" Q
90 . I $P(IBENCL,"^",8) S IBRMARK="PROJECT 112/SHAD" Q
91 ;
92 ; look up PCE info
93 D ENCEVENT^PXKENC(IBPCEX)
94 ;
95 S IBVRNB=$$RNB($G(^TMP("PXKENC",$J,IBPCEX,"VST",IBPCEX,800)),.IBARR)
96 ;
97 ; find dx rnb's
98 S IBDX=0 F S IBDX=$O(^TMP("PXKENC",$J,IBPCEX,"POV",IBDX)) Q:'IBDX S IBDX(+$G(^TMP("PXKENC",$J,IBPCEX,"POV",IBDX,0)))=$$RNB($G(^TMP("PXKENC",$J,IBPCEX,"POV",IBDX,800)),.IBARR)
99 ;
100 ; look for v cpt's with IBDX
101 S IBCPT=0 F S IBCPT=$O(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT)) Q:'IBCPT F IBP=5,9,10,11 Q:'$D(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0)) D
102 . ;
103 . ; dx exists in v cpt but not v pov use visit level determination
104 . I $P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP),'$D(IBDX($P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP))) D:IBVRNB REL(IBVRNB) Q
105 . ;
106 . ; use dx determination (where dx exists on v cpt)
107 . I $P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP) D:$G(IBDX($P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP))) REL($G(IBDX($P(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0),"^",IBP)))) Q
108 ;
109 ; check for no assoc dx and apply visit level determination
110 S IBCPT=0 F S IBCPT=$O(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT)) Q:'IBCPT D
111 . S IBDX=0 F IBP=5,9,10,11 Q:IBDX I +$P($G(^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT,0)),"^",IBP) S IBDX=1
112 . I 'IBDX,IBVRNB D REL(IBVRNB)
113 ;
114 ; if some procedures left, then we need to bill, set return array
115 I $D(^TMP("PXKENC",$J,IBPCEX,"CPT")) S IBRMARK="" M IBR=^TMP("PXKENC",$J,IBPCEX)
116 ;
117CLQ K ^TMP("PXKENC",$J)
118 Q IBRMARK
119 ;
120RNB(IBDATA,IBARR) ; find rnb's
121 ; pass in PCE 800 data (visit or v pov) to find any reasons not billalbe
122 ; IBARR = classifications that could apply to patient
123 ; the RNB number returned is from the IBARR number (SDCO21 array)
124 N IBX,IBR S IBR=""
125 S IBX=0 F S IBX=$O(IBARR(IBX)) Q:'IBX!(IBR) I $P(IBDATA,"^",$P($T(CLDATA+(IBX+1)),"^",2)) S IBR=IBX
126 Q IBR
127 ;
128REL(IBRNB) ; kills of tmp if related and set IBRMARK
129 K ^TMP("PXKENC",$J,IBPCEX,"CPT",IBCPT)
130 S IBRMARK=$P($T(CLDATA+(IBRNB+1)),"^",3)
131 Q
132 ;
133CLDATA ; classification data
134 ; format is: SCDO21 array^vpov/vcpt/visit 800 piece^reason not billable
135 ;;1^2^AGENT ORANGE
136 ;;2^3^IONIZING RADIATION
137 ;;3^1^SC TREATMENT
138 ;;4^4^SOUTHWEST ASIA
139 ;;5^5^MILITARY SEXUAL TRAUMA
140 ;;6^6^HEAD/NECK CANCER
141 ;;7^7^COMBAT VETERAN
142 ;;8^8^PROJECT 112/SHAD
143 ;
Note: See TracBrowser for help on using the repository browser.