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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1IBAECU3 ;WOIFO/SS-LTC PHASE 2 UTILITIES ; 20-FEB-02
2 ;;2.0;INTEGRATED BILLING;**176**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;****** Outpatient LTC related utilities *********
6 ;/*--
7 ;Returns info about all visits via ^TMP($J,IBLB,IBDFN) global
8 ;
9 ;Input:
10 ;
11 ;IBFRBEG- first date (in FM format),must be a valid,
12 ; (wrong date like 3000231 will cause mistakes)
13 ;IBFREND- last date (in FM format),must be a valid date
14 ; if any of dates above > yesterday it will be set to yesterday
15 ;
16 ;IBDFN - patient's ien in file (#2)
17 ;IBLB - any string to identify results in ^TMP($J,IBLB
18 ;Output:
19 ;
20 ;temp global array with inpatient info:
21 ; ^TMP($J,IBLB,IBDFN,date,"M"/"L",IEN40968)=L/M^stopcode^
22 ;
23 ; where pieces:
24 ; #1 - "L" for LTC, "M" for MeansTest
25 ; #2 - stopcode
26 ; #3 - empty
27 ; #4 - pointer to #350.1 IB action type
28 ;Returns:
29 ; 0 - none
30 ; 1 - if any leave or stay days in the period
31OUTPINFO(IBFRBEG,IBFREND,IBDFN,IBLB) ;
32 N IBVAL,IBCBK,IBFILTER,IBRES
33 S IBVAL("DFN")=IBDFN,IBVAL("BDT")=IBFRBEG-.1,IBVAL("EDT")=+(IBFREND_".9999999")
34 S IBFILTER=""
35 ; we look only for STATUS=CHECKED OUT i.e. $P(Y0,U,12)=2 in IBCBK
36 ; consider only parent encounters, appts checked out
37 S IBCBK="I '$P(Y0,U,6),$P(Y0,U,12)=2 S IBRES=$$STOPINFO^IBAECU3($P(Y0,U,3),0),^TMP($J,IBLB,IBDFN,+Y0\1,Y)=IBRES"
38 D SCAN^IBSDU("PATIENT/DATE",.IBVAL,IBFILTER,IBCBK,1) K ^TMP("DIERR",$J)
39 Q +$O(^TMP($J,IBLB,IBDFN,0))>0
40 ;/**
41 ;get stop-code related info
42 ;IB407 pointer to file #40.7
43 ;IBDT - date to get rate, if 0 then will not return a rate in 3rd piece
44 ;returns
45 ;IBTYPE_"^"_IBCODE_"^"_IBRATE_"^"_IBATYP
46 ;IBCARE - "M" for means test, "L" for LTC
47 ;IBCODE - AMIS REPORTING STOP CODE
48 ;IBRATE - rate for LTC, 0 for Means test
49 ;IBATYP - ien of 350.1
50STOPINFO(IB407,IBDT) ;
51 N Y,X
52 N IBI,IBCR,IBCODE,IBATYP,IBCHG
53 N IBSCDATA,IBNAME
54 D DIQ407^IBEMTSCU(IB407,1)
55 S IBCODE=$G(IBSCDATA(40.7,IB407,1,"E"))
56 Q:+IBCODE=0 ""
57 S IBNAME=$P($$LTCSTOP^IBAECU(IB407),"^",2)
58 Q:IBNAME="" "M^"_IBCODE_"^^"
59 S IBATYP=$O(^IBE(350.1,"B",IBNAME,0))
60 Q:+IBATYP=0 ""
61 S IBCHG=""
62 I +$G(IBDT)>0 D
63 . S IBCHG=0
64 . D COST^IBAUTL2
65 Q "L^"_IBCODE_"^"_IBCHG_"^"_IBATYP
66 ;
67 ;returns rate for different LTC services
68 ;INPUT:
69 ;IBCARE=1 - outpatient(clinic stopcode),IBTYPE=2 - inpatient(treating specialty)
70 ;IBCODE - treating specialty(outpatient) or clinic stopcode (inpatient)
71 ;IBDT - date of care
72 ;if not found - returns 0
73GETRATE(IBCARE,IBCODE,IBDT) ;
74 N IBCHG,IBATYP,IBTAG
75 N IBI,IBCR,IBNAME
76 S:'$D(U) U="^"
77 S (IBCHG,IBATYP)=0
78 S:IBCARE=1 IBTAG="C"_IBCODE,IBNAME=$P($T(@IBTAG^IBAECU1),";",3)
79 S:IBCARE=2 IBTAG="T"_IBCODE,IBNAME=$P($T(@IBTAG^IBAECU1),";",3)
80 Q:IBNAME="" IBCHG
81 S IBATYP=$O(^IBE(350.1,"B",IBNAME,0))
82 Q:+IBATYP=0 IBCHG
83 D COST^IBAUTL2
84 Q IBCHG_"^"_IBATYP
85 ;/**
86 ;is there any outp episode with that day
87 ;Input:
88 ;IBDFN - dfn of the patient
89 ;IBDT1 - date
90 ;IBTMPLB - ^TMP global subscript like IBADM in $$INPINFO
91 ;Output:
92 ;Returns "a^b" where :
93 ;a - number of LTC admissions on this date
94 ;b - number of Means Test admissions on this date
95 ;if "" - nothing
96 ; means test:
97 ;.IBVIS("M",#)=treating specialty^
98 ; LTC:
99 ;.IBVIS("L",#)=treating specialty^ien of 350.1I action type
100ISOUTP(IBDFN,IBDT1,IBTMPLB,IBVIS) ;*/
101 N IB40968,IBRETV,IBD,IB1
102 S IB40968=0,IBRETV=""
103 F S IB40968=$O(^TMP($J,IBTMPLB,IBDFN,IBDT1,IB40968)) Q:+IB40968=0 D
104 . S IBD=$G(^TMP($J,IBTMPLB,IBDFN,IBDT1,IB40968))
105 . S IB1=$P(IBD,"^",1)
106 . I IB1="L" S $P(IBRETV,"^",1)=$P($G(IBRETV),"^",1)+1
107 . I IB1="M" S $P(IBRETV,"^",2)=$P($G(IBRETV),"^",2)+1
108 . S IBVIS(IB1,IB40968)=$P(IBD,"^",2)_"^"_$P(IBD,"^",4)
109 Q IBRETV
110 ;
111 ;checks if there is Means test outpatient visits this date and
112 ;cancels them if there is a charge
113CHKMTOUT(IBDFN,IBDT,IBTMPLB) ;
114 N IBV1
115 N RETIENS S RETIENS=0
116 S IBV1=$$ISOUTP(IBDFN,IBDT,IBTMPLB,.RETIENS) Q:+$P(IBV1,"^",2)=0
117 S IBV1=0
118 F S IBV1=$O(RETIENS("M",IBV1)) Q:+IBV1=0 D
119 . D CANCVIS^IBAECU5(IBDFN,IBDT)
120 Q
121 ;
122 ;
123 ;return IB action type based on treating specialty (42.4)
124 ;or clinic stop code
125 ;IBCARE=1 - outpatient(clinic stopcode),IBTYPE=2 - inpatient(treating specialty)
126 ;IBCODE - treating specialty(outpatient) or clinic stopcode (inpatient)
127GET3501(IBCARE,IBCODE) ;
128 N IBATYP,IBNAME
129 S:IBCARE=1 IBTAG="C"_IBCODE,IBNAME=$P($T(@IBTAG^IBAECU1),";",3)
130 S:IBCARE=2 IBTAG="T"_IBCODE,IBNAME=$P($T(@IBTAG^IBAECU1),";",3)
131 Q:IBNAME="" 0
132 S IBATYP=$O(^IBE(350.1,"B",IBNAME,0))
133 Q +IBATYP
134 ;
Note: See TracBrowser for help on using the repository browser.