source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBTRE.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: 4.6 KB
Line 
1IBTRE ;ALB/AAS - CLAIMS TRACKING EDITOR ;27-JUN-1993
2 ;;2.0;INTEGRATED BILLING;**122,51,276**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ; -- main entry point for IBT CLAIMS TRACKING EDIT
6EN ;
7 I '$D(DT) D DT^DICRW
8 K XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD,IBCNS,IBCDFN,IBFASTXT,VA,VAERR,VA200,IBCNT,IBI,IBTBDT,IBTEDT,IBUR,VAIN,VAEL
9 D EN^VALM("IBT CLAIMS TRACKING EDITOR")
10ENQ K IBFASTXT,IBSCP,IBOTB,XQORS,VALMEVL,DFN,IBTRN,IBTRV,IBTRC,IBTRD,IBCNS,IBCDFN,VA,VAERR,VA200,IBCNT,IBI,IBTBDT,IBTEDT,IBUR,IBTRPRF,VAEL,VAIN,PRECERT,IBAMNT,IBDGCR,IBDGCRU1,IBETYP,IBETYPD,IBLCNT,IBTEXT,IBTRND,X,Y,Z,IBTMPNM
11 K IBAPEAL,IBCDFN,IBCNT,IBDEN,IBDENIAL,IBDENIAL,IBPARNT,IBPEN,IBPENAL,IBTCOD,IBTRDD,IBTRSV,IBTYPE,VAINDT,VA,VALMBCK,OFFSET,I1,I3,IBNEW,IBDENT,IBOE,Z1,T,SDCNT
12 Q
13 ;
14HDR ; -- header code
15 D PID^VADPT
16 S VALMHDR(1)="Claims Tracking Entries for: "_$E($P($G(^DPT(DFN,0)),"^"),1,20)_" "_$E($G(^(0)),1)_VA("BID")
17 S VALMHDR(2)=" for Visits beginning on: "_$$DAT1^IBOUTL(IBTBDT)_" to "_$$DAT1^IBOUTL(IBTEDT)
18 Q
19 ;
20INIT ; -- init variables and list array
21 S U="^",VALMCNT=0,VALMBG=1
22 K ^TMP("IBTRE",$J),^TMP("IBTREDX",$J)
23 K I,X,XQORNOD,DA,DR,DIE,DNM,DQ,IBTEDT,IBTBDT
24 D PAT^IBCNSM I $D(VALMQUIT) G INITQ
25 S IBTBDT=$$FMADD^XLFDT(DT,-365) ; default start date 1 year in past
26 S IBTEDT=$$FMADD^XLFDT(DT,14) ;default end date is 7 days in future.
27 D BLD
28INITQ Q
29 ;
30BLD ; -- Build list of tracking entries
31 K ^TMP("IBTRE",$J),^TMP("IBTREDX",$J)
32 N IBII,J,IBTRN,IBTRND,IBTRND1,VAIN,IBCUR,IBSAV,IBSCP
33 S IBCNT=0,VALMCNT=0
34 I '$G(IBTRPRF) S IBTRPRF=123
35 I IBTRPRF<10 S X=$S(IBTRPRF=1:"IBTRE HR MENU",IBTRPRF=2:"IBTRE IR MENU",IBTRPRF=3:"IBTRE BI MENU",1:"IBTRE MENU") D PROT^IBTRPR(X)
36 S VALMSG=$$MSG^IBTUTL3(DFN)
37 K VAINDT S VA200="" D INP^VADPT I VAIN(1) D
38 .S IBTRN=$O(^IBT(356,"AD",+VAIN(1),0)),IBCUR="*"
39 .D:IBTRN 1
40 .S IBSAV=IBTRN
41 .S VALMSG=$G(VALMSG)_" *=Current Admission "
42 .K VAIN,VA200,VAINDT
43 .Q
44 ;
45 S IBCUR="",IBI=-(IBTEDT+.24)
46 F S IBI=$O(^IBT(356,"APTDT",DFN,IBI)) Q:IBI=""!(IBI>(-IBTBDT+.0001)) S IBTRN=0 F S IBTRN=$O(^IBT(356,"APTDT",DFN,IBI,IBTRN)) Q:'IBTRN D 1
47BLDQ Q
48 ;
491 ; -- build the entry
50 Q:$G(IBSAV)=IBTRN
51 W "."
52 S IBTRND=$G(^IBT(356,IBTRN,0)),IBTRND1=$G(^(1)) ; tracking data
53 Q:+$P(IBTRND,"^",20)<1 ; quit if inactive
54 S IBCNT=IBCNT+1
55 S X=""
56 S X=$$SETFLD^VALM1(IBCNT,X,"NUMBER")
57 S X=$$SETFLD^VALM1(IBCUR_$P($G(^IBE(356.6,+$P(IBTRND,"^",18),0)),"^",2),X,"TYPE")
58 S X=$$SETFLD^VALM1($$DAT1^IBOUTL($P(IBTRND,"^",6),2),X,"DATE")
59 S X=$$SETFLD^VALM1($$EXPAND(356,.24,$P(IBTRND,"^",24)),X,"INSUR")
60 S IBUR="" S:$P(IBTRND,"^",25) IBUR="R" S:$P(IBTRND,"^",26) IBUR=IBUR_"S" S:$P(IBTRND,"^",27) IBUR=IBUR_"L"
61 S X=$$SETFLD^VALM1(IBUR,X,"UR")
62 S X=$$SETFLD^VALM1($S(+$P(IBTRND,"^",19):"NO",1:"YES"_$$ECME(+$P(IBTRND,"^",11),1)),X,"BILLABLE")
63 S X=$$SETFLD^VALM1($$EXPAND(356,.31,$P(IBTRND,"^",31)),X,"ROI")
64 S X=$$SETFLD^VALM1($$ADMDIAG^IBTRE6(IBTRN),X,"DIAGNOSIS")
65 S X=$$SETFLD^VALM1($S($P(IBTRND,"^",7)=3:"YES",1:"NO"),X,"URGENT")
66 S X=$$SETFLD^VALM1($$DAY(IBTRN),X,"DAYS")
67 S X=$$SETFLD^VALM1($P($G(^DGCR(399,+$P(IBTRND,"^",11),0)),U),X,"INITIAL")
68 S X=$$SETFLD^VALM1($$PRECRT^IBTRC1(IBTRN),X,"PRECERT")
69 S X=$$SETFLD^VALM1($E($$EXPAND(356,.12,$P(IBTRND,"^",12)),1,14),X,"SPECIAL")
70 I $G(VAIN(4)) S X=$$SETFLD^VALM1($P(VAIN(4),"^",2),X,"WARD")
71 D SET(X)
72BQ Q
73 ;
74HELP ; -- help code
75 S X="?" D DISP^XQORM1 W !!
76 Q
77 ;
78EXIT ; -- exit code
79 K ^TMP("IBTRE",$J),^TMP("IBTREDX",$J)
80 K DFN
81 D FULL^VALM1,CLEAN^VALM10
82 Q
83 ;
84SET(X) ; -- set arrays
85 S VALMCNT=VALMCNT+1
86 S ^TMP("IBTRE",$J,VALMCNT,0)=X
87 S ^TMP("IBTRE",$J,"IDX",VALMCNT,IBCNT)=""
88 S ^TMP("IBTREDX",$J,IBCNT)=VALMCNT_"^"_IBTRN
89 Q
90 ;
91EXPAND(FILE,FIELD,VALUE) ; -- return special conditions
92 N Y
93 S Y=VALUE
94 I 'FILE!('FIELD)!(VALUE="") G EXPQ
95 S Y=$$EXTERNAL^DILFD(FILE,FIELD,,VALUE)
96 K ^TMP("DIERR",$J)
97EXPQ Q Y
98 ;
99DAY(X) ; -- compute number of days approved for tracking id
100 N IBI,IBTRC,IBTRCD,IBDAY,IBCDT,IBMAX
101 ;
102 S (IBI,IBDAY)=0 F S IBI=$O(^IBT(356.2,"C",IBTRN,IBI)) Q:'IBI D Q:IBDAY="ALL"
103 .S IBTRCD=$G(^IBT(356.2,+IBI,0))
104 .I $P(IBTRCD,"^",19)'=10 Q ;review status must be complete
105 .I $P($G(^IBE(356.7,+$P(IBTRCD,"^",11),0)),"^",3)'=10 Q ;must be an approval
106 .I $P($G(^IBT(356.2,+IBI,1)),"^",8) S IBDAY="ALL" Q
107 .S IBDAY=IBDAY+$$DAY^IBTUTL3($P(IBTRCD,"^",12),$P(IBTRCD,"^",13),IBTRN)
108 I $P(^IBT(356,IBTRN,0),"^",5) S IBCDT=$$CDT^IBTODD1(IBTRN) I +IBCDT,$P(IBCDT,"^",2) S IBMAX=$$FMDIFF^XLFDT($P(IBCDT,"^",2),+IBCDT)
109 I $G(IBMAX),IBDAY>IBMAX S IBDAY=IBMAX
110 Q IBDAY
111 ;
112ECME(IBBIL,IBNCAN) ;ECME flag
113 I 'IBBIL Q ""
114 I $P($G(^DGCR(399,IBBIL,"M1")),U,8)="" Q ""
115 I $G(IBNCAN),$P($G(^DGCR(399,IBBIL,0)),U,13)=7 Q "" ; cancelled
116 Q "e"
Note: See TracBrowser for help on using the repository browser.