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

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

initial load of WorldVistAEHR
File size: 6.1 KB
RevLine 
[613]1IBTRKR ;ALB/AAS - CLAIMS TRACKER - AUTO-ENROLLER ; 4-AUG-93
2 ;;2.0;INTEGRATED BILLING;**23,43,45,56,214**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5INP ; -- Inpatient Tracker
6 ; called by ibamtd from DGPM MOVEMENT EVENTS
7 ; add edit delete
8 ; dgpma = after movement 0th node file 405 : data data null
9 ; dgpmp = prior movement 0th node file 405 : null data data
10 ; dfn = ien of patient
11 ;
12 N %,%H,%I,IBMVAD,IBMVTP,IBTRKR
13 ;
14 ; inpatient claims tracking turned off
15 S IBTRKR=$G(^IBE(350.9,1,6)) I '$P(IBTRKR,"^",2) Q
16 ;
17 ; movement type 1=admission, 2=transfer, 3=discharge, 6=specialty chg
18 S IBMVTP=$S($P(DGPMA,"^",2):$P(DGPMA,"^",2),1:$P(DGPMP,"^",2)) I 'IBMVTP Q
19 ;
20 ; $p(14)=admission movement ptr entry in file 405
21 S IBMVAD=$S(DGPMA'="":$P(DGPMA,"^",14),1:$P(DGPMP,"^",14)) I 'IBMVAD Q
22 ;
23 D WRITE("Updating claims tracking ... ",2)
24 ;
25 I '$D(VAIN(1)) D INP^VADPT
26 ;
27 ; add/edit admission
28 I IBMVTP=1 D ADMIT Q
29 ;
30 ; transfer to asih (patch 23)
31 I $P($G(^DGPM(+$P(DGPMA,"^",15),0)),"^",2)=1 S IBMVAD=$P(DGPMA,"^",15) D ADMIT Q
32 ;
33 ; specialty change
34 I IBMVTP=6 D SPECIAL Q
35 ;
36 D WRITE("completed.")
37 Q
38 ;
39 ;
40WRITE(MSG,FF) ; write message on screen if not silent
41 ; write 'F'orm 'F'eeds count followed by msg (optional)
42 N %
43 I '$D(IB20),'$G(DGQUIET) D
44 . F %=1:1:$G(FF) W !
45 . W MSG
46 Q
47 ;
48 ;
49ADMIT ; -- process admission movements
50 ; ibmvad is admission movement pointer to file 405
51 ; dgpma is movement entry from file 405
52 N %,%H,%I,IBCTFLAG,IBNEW,IBRANDOM,IBTRN,LASTADM,LASTDA,LASTDATA
53 ;
54 ; this is a deleted admission from file 405, dgpma=null
55 I DGPMA="" D DELADMIT Q
56 ;
57 ; try and relink to existing entry if already there
58 ; find the last admission, check to make sure its inactive and there
59 ; is not a pointer to the movement file ($p(5)). if the current
60 ; admission date is within 5 days, update the entry.
61 S LASTADM=$O(^IBT(356,"APTY",DFN,+$O(^IBE(356.6,"AC",1,0)),9999999),-1)
62 I LASTADM S LASTDA=+$O(^IBT(356,"APTY",DFN,1,LASTADM,0)),LASTDATA=$G(^IBT(356,LASTDA,0)) I $P(LASTDATA,"^",20)=0,$P(LASTDATA,"^",5)="" D Q:$G(IBCTFLAG)
63 . S %=$$FMDIFF^XLFDT($P(DGPMA,"."),$P(LASTADM,"."))
64 . I %>-5,%<5 D RELINK^IBTRKRU(LASTDA,IBMVAD,$P(DGPMA,"^")),RELBULL^IBTRKRBR(DFN,LASTDA,DGPMA,+$G(VAIN(3))),WRITE("entry re-linked.") S IBCTFLAG=1
65 ;
66 ; random sampler, admission date must equal today (dt)
67 I +$G(VAIN(3)),($E(+DGPMA,1,7)=DT) S IBRANDOM=$$RANDOM^IBTRKR1(+VAIN(3))
68 ;
69 N D,D0,DI,DIG,DIH,DIU,DIV,DQ,IBADMDT,IBETYP ; variables left by ibtutl
70 ; inpatient claims tracking = all patients
71 I $P(IBTRKR,"^",2)=2 D Q
72 . D ADM^IBTUTL(IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM),$P(DGPMA,"^",27))
73 . D WRITE("entry "_$S($G(IBNEW):"added.",1:"edited."))
74 . I $G(IBRANDOM),$G(IBTRN) D ADMTBULL^IBTRKRBA(DFN,IBTRN,DGPMA,+$G(VAIN(3)))
75 ;
76 ; inpatient claims tracking = insured and ur only
77 I $P(IBTRKR,"^",2)=1,$S($G(IBRANDOM):1,'$$INSURED^IBCNS1(DFN,+DGPMA):0,1:$$PTCOV^IBCNSU3(DFN,+DGPMA,"INPATIENT")) D Q
78 . D ADM^IBTUTL(IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM),$P(DGPMA,"^",27))
79 . D WRITE("entry "_$S($G(IBNEW):"added.",1:"edited."))
80 . I $G(IBRANDOM),$G(IBTRN) D ADMTBULL^IBTRKRBA(DFN,IBTRN,DGPMA,+$G(VAIN(3)))
81 ;
82 ; inpatient claims tracking = insured and ur only, but not insurred
83 ; need to send off RDV in background
84 N IBT
85 I $P(IBTRKR,"^",2)=1,'$$INSURED^IBCNS1(DFN,+DGPMA),$$TFL^IBARXMU(DFN,.IBT),'$D(^IBT(356,"ARDV",DFN)) D ADM^IBCNRDV(DFN,IBMVAD,+$E(+DGPMA,1,12),$G(IBRANDOM),$P(DGPMA,"^",27)) D WRITE("Remote Query for insurance sent.") Q
86 ;
87 ;
88 D WRITE("no action taken.")
89 Q
90 ;
91 ;
92DELADMIT ; deleted admission
93 N DA,FILE,IBDATE,IBTRN,SPECALTY
94 S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0)) I IBTRN D Q
95 . S SPECALTY=+$P($G(^UTILITY($J,"ATS",+$P(DGPMP,"^"),+$O(^UTILITY($J,"ATS",+$P(DGPMP,"^"),0)))),"^",9)
96 . ; send information bulletin
97 . D DELBULL^IBTRKRBD(DFN,IBTRN,DGPMP,SPECALTY)
98 . ; clean up files pointing to 405
99 . F FILE=356.9,356.91,356.94 S DA=0 F S DA=$O(^IBT(FILE,"C",+IBMVAD,DA)) Q:'DA D DELETE^IBTRKRU(FILE,DA)
100 . S IBDATE=0 F S IBDATE=$O(^IBT(356.93,"AMVD",+IBMVAD,IBDATE)) Q:'IBDATE S DA=0 F S DA=$O(^IBT(356.93,"AMVD",+IBMVAD,IBDATE,DA)) Q:'DA D DELETE^IBTRKRU(356.93,DA)
101 . ; inactivate entry in ct 356
102 . D INACTIVE^IBTRKRU(IBTRN)
103 . D WRITE("entry inactivated.")
104 D WRITE("no action taken.")
105 Q
106 ;
107 ;
108SPECIAL ; specialty change
109 ; deleted movement
110 I DGPMA="" D WRITE("no action taken.") Q
111 ;
112 ; if specialty change is past 7 days, quit
113 I +DGPMA<$$FMADD^XLFDT(+DT,-7) D WRITE("no action taken.") Q
114 ;
115 N IBDT,IBTSA,IBTSP,IBTRC,IBTRN,IBTRV
116 ; treating specialty after
117 S IBTSA=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$P(DGPMA,"^",9),0)),"^",2),0)),"^",3)
118 ;
119 ; treating specialty before
120 I DGPMP'="" S IBTSP=$P($G(^DIC(42.4,+$P($G(^DIC(45.7,+$P(DGPMP,"^",9),0)),"^",2),0)),"^",3)
121 ;
122 I DGPMP="" D
123 . S IBDT=9999999.9999999-$P(DGPMA,"^")
124 . S IBTSP=$P($G(^DIC(45.7,+$O(^(+$O(^DGPM("ATS",+DFN,+IBMVAD,+IBDT)),0)),0)),"^",2)
125 . S IBTSP=$P($G(^DIC(42.4,+IBTSP,0)),"^",3)
126 ;
127 ; no change in major bed section
128 I IBTSA=IBTSP D WRITE("no action taken.") Q
129 ;
130 S IBTRN=$O(^IBT(356,"AD",+IBMVAD,0))
131 ;
132 ; tracked as hospital review
133 I $O(^IBT(356.1,"C",+IBTRN,0)) D
134 . I $$ALREADY(356.1,+DGPMA) Q
135 . D PRE^IBTUTL2($E(+DGPMA,1,7),IBTRN,30)
136 . I $G(IBTRV) D COMMENT^IBTRKRU(356.1,+IBTRV)
137 ;
138 ; tracked as insurance review
139 I $O(^IBT(356.2,"C",+IBTRN,0)) D
140 . I $$ALREADY(356.2,+DGPMA) Q
141 . I $P($G(^IBT(356,+IBTRN,0)),"^",24) D COM^IBTUTL3($E(+DGPMA,1,12),IBTRN,30)
142 . I $G(IBTRC) D COMMENT^IBTRKRU(356.2,+IBTRC)
143 ;
144 D WRITE("completed.")
145 Q
146 ;
147 ;
148ALREADY(FILE,DATE) ; -- see if already is review for date
149 N X,Y,IBX
150 S IBX=0
151 S X=$P(DATE,".")+.25
152 S Y=$O(^IBT(FILE,"ATIDT",+IBTRN,-X)) S Y=-Y I Y,$P(Y,".")=$P(DATE,".") S IBX=1
153 Q IBX
154 ;
155 ;
156NIGHTLY ; -- nightly job for claims tracking, called by IBAMTC
157 ;
158 D UPDATE^IBTRKR1 ; update claims tracking site parameters (random sampler)
159 D ^IBTRKR2 ; add scheduled admissions to tracking
160 D ^IBTRKR3 ; add rx refill to outpatient encounters
161 D ^IBTRKR4 ; add outpatient encounters to tracking
162 D ^IBTRKR5 ; add outpatient prosthetics item to tracking
163 Q
Note: See TracBrowser for help on using the repository browser.