source: WorldVistAEHR/trunk/r/FEE_BASIS-FB/FBPCR4.m@ 1556

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1FBPCR4 ;WOIFO/SS-LTC PHASE 3 UTILITIES ;03/17/04
2 ;;3.5;FEE BASIS;**48,76**;JAN 30, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6 ;
7INSURED(FBDFN,FBINDT1,FBINDT2) ;check if the patient has insurance
8 ;FBDFN - patient DFN
9 ;FBINDT1 - the treatment date - for outpatients,
10 ; FROM date - for inpatients,
11 ; certified date - for Pharmacy
12 ;FBINDT2 (optional) - TO date for inpatients
13 N FBINS1
14 S FBINS1=+$$INSUR^IBBAPI(FBDFN,FBINDT1)
15 I FBINS1<0 D ADDERR(DFN) Q FBINCUNK ;error handling
16 Q:'$D(FBINDT2) FBINS1
17 Q:FBINS1=1 1 ;if was insured for FROM date - don't check TO date
18 S FBINS1=+$$INSUR^IBBAPI(FBDFN,FBINDT2) ;otherwise return the state on TO date
19 I FBINS1<0 D ADDERR(DFN) Q FBINCUNK ;error handling
20 Q FBINS1
21 ;
22ADDERR(FBDFN) ;add error to ^TMP, FBDFN - patient DFN
23 I FBPARTY=1 Q
24 N DFN,FBPNAME,FBPID,FBDOB,FBPI
25 S DFN=FBDFN
26 D VET^FBPCR
27 S ^TMP($J,"FBINSIBAPI")=$G(^TMP($J,"FBINSIBAPI"))+1
28 S ^TMP($J,"FBINSIBAPI",DFN)=FBPID_"^"_FBDOB_"^"_FBPNAME
29 Q
30 ;
31ERRHDL ;Error handler called from FBPCR
32 I +$G(^TMP($J,"FBINSIBAPI"))=0 Q ;no errors
33 D PRNUNKN
34 Q
35 ;
36PRNUNKN ;write output
37 N FBDFN,FBDATA
38 D PAGEINS
39 I FBPG>1&(($Y+15)>IOSL) D HEADER Q:FBOUT
40 S FBDFN=0 F S FBDFN=$O(^TMP($J,"FBINSIBAPI",FBDFN)) Q:FBDFN']""!(FBOUT) D Q:FBOUT
41 . I ($Y+6)>IOSL D PAGEINS Q:FBOUT
42 . S FBDATA=$G(^TMP($J,"FBINSIBAPI",FBDFN))
43 . W !,$P(FBDATA,"^",3),?40,$P(FBDATA,"^",1),?62,$P(FBDATA,"^",2)
44 Q
45PAGEINS ;new page
46 D CHKPAGE Q:FBOUT
47 D HEADER Q:FBOUT
48 Q
49CHKPAGE ;form feed when new station/patient
50 S FBSTA=$G(FBPSF)_$G(FBPT)
51 I FBCRT&(FBPG'=0) D CR^FBPCR Q:FBOUT
52 I FBPG>0!FBCRT W @IOF
53 S FBPG=FBPG+1
54 Q
55HEADER ;main header
56 N FBSTR1 S FBSTR1="List of the patients whose insurance information is currently unavailable"
57 W !?(IOM-30/2),"POTENTIAL COST RECOVERY REPORT"
58 W !?(IOM-$L(FBSTR1)/2),FBSTR1
59 W !?71,"Page: ",FBPG
60 W !,"Patient",?40,"Pat. ID",?62,"DOB"
61 W !,FBDASH
62 Q
63 ;/**filtering logic
64 ;input:
65 ; FBPARTY: 1-Patient copay only,2-Insurance only,3-Both
66 ; FBCOPAY: 1-LTC copays only,2-MT copays only,3-Both
67 ; FBINS: 1- has insurance,0-none
68 ; FBCATC: 0 - no copay,1- MT copay,2-LTC copay,3-no 1010EC,4-more analysis is needed
69 ;output:
70 ; 1 - include to report
71 ; 0 - exclude from report
72FILTER() ;*/
73 I FBPARTY=1,FBCATC=0 Q 0
74 I FBPARTY=2,FBINS=0 Q 0
75 I FBPARTY=3,FBINS=1 Q 1
76 I FBCOPAY=1,FBCATC<2 Q 0
77 I FBCOPAY=2,FBCATC'=1 Q 0
78 Q 1
79 ;
80 ;/**
81 ; returns LTC status
82 ; input: Patient's DFN, Date of Care
83 ;
84 ; return values:
85 ; 0 - no1010EC
86 ; 1 - exemption from LTC copay
87 ; 2 - LTC copay
88LTCST(DFN,FBDT) ;*/
89 Q +$$COPAY^EASECCAL(DFN,$$LASTDT(FBDT),1)
90 ;
91LASTDT(X) ; compute the last day of the month in X
92 N XM,X1,X2
93 I $E(X,4,5)=12 Q $E(X,1,5)_"31"
94 S XM=$E(X,4,5)+1
95 S:XM<10 XM="0"_XM
96 S X1=$E(X,1,3)_XM_"01"
97 S X2=-1
98 D C^%DTC
99 Q X
100 ;
101 ;
102 ;prepares local array with LTC POV codes
103 ;input: FBARRLTC must be defined
104 ;output: FBARRLTC with POV codes
105MKARRLTC ;
106 N FBPOV,FBIEN,FBLTCTYP
107 S FBPOV="" F S FBPOV=$O(^FBAA(161.82,"C",FBPOV)) Q:'FBPOV S FBIEN=+$O(^FBAA(161.82,"C",FBPOV,0)),FBLTCTYP=+$P($G(^FBAA(161.82,FBIEN,0)),"^",4) S:FBLTCTYP=1!(FBLTCTYP=2) FBARRLTC(FBPOV)=FBLTCTYP
108 Q
109 ;/**
110 ; Determine if POV code is related to LTC.
111 ;Input:
112 ; FBPOV - POV code, pointer to #161.82
113 ; FBARRLTC must be defined and populated - array with LTC POV codes (see MKARRLTC)
114 ;Output:
115 ; returns
116 ; 0 - it is not LTC service
117 ; 1 - this POV code is for LTC and recoverable from LTC copayment
118 ; 2 - this POV code is for LTC but it is not a subject of LTC copayment
119ISLTC(FBPOV) ;*/
120 Q +$G(FBARRLTC(FBPOV))
121 ;
Note: See TracBrowser for help on using the repository browser.