source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASECU2.m@ 1042

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

initial load of WorldVistAEHR
File size: 2.7 KB
Line 
1EASECU2 ;ALB/LBD - Income Utilities ;14 AUG 2001
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
3 ;
4GETIENS(DFN,DGPRI,DGDT) ;Look-up individual annual income and income relation
5 ; Input -- DFN Patient file IEN
6 ; DGPRI Patient Relation IEN
7 ; DGDT Date/Time
8 ; Output -- DGINI Individual Annual Income IEN
9 ; DGIRI Income Relation IEN
10 ; DGERR 1=ERROR and 0=NO ERROR
11 S DGERR=0
12 S DGINI=$$GETIN(DFN,DGPRI,DGDT) S:DGINI<0 DGERR=1
13 I 'DGERR S DGIRI=$$GETIR(DFN,DGINI) S:DGIRI<0 DGERR=1
14 Q
15 ;
16GETIN(DFN,DGPRI,DGDT) ;Look-up individual annual income
17 ; Add a new entry if one is not found
18 ; Input -- DFN Patient file IEN
19 ; DGPRI Patient Relation IEN
20 ; DGDT Date/Time
21 ; Output -- Individual Annual Income IEN
22 N DGINI,DGYR
23 S DGYR=$E(DGDT,1,3)_"0000"
24 ; get IEN of individual annual income for LTC co-pay (test type 3)
25 S DGINI=+$$IAI^DGMTU3(DGPRI,DGYR,3)
26 I '$D(^DGMT(408.21,DGINI,0)) S DGINI=$$ADDIN(DFN,DGPRI,DGYR)
27GETINQ Q $S(DGINI>0:DGINI,1:-1)
28 ;
29ADDIN(DFN,DGPRI,DGYR) ;Add a new individual annual income entry
30 ; Input -- DFN Patient file IEN
31 ; DGPRI Patient Relation IEN
32 ; DGYR Test Year
33 ; Output -- New Individual Annual Income IEN
34 N DA,DD,DGINI,DGNOW,DIC,DIK,DINUM,DLAYGO,DO,X,Y,%
35 D NOW^%DTC S DGNOW=%
36 S X=DGYR,(DIC,DIK)="^DGMT(408.21,",DIC(0)="L",DLAYGO=408.21
37 D FILE^DICN S DGINI=+Y
38 I DGINI>0 D
39 .L +^DGMT(408.21,DGINI)
40 .S $P(^DGMT(408.21,DGINI,0),"^",2)=DGPRI,^("USR")=DUZ_"^"_DGNOW
41 .I $G(DGMTI) S ^DGMT(408.21,DGINI,"MT")=DGMTI
42 .S DA=DGINI D IX1^DIK L -^DGMT(408.21,DGINI)
43ADDINQ Q $S(DGINI>0:DGINI,1:-1)
44 ;
45GETIR(DFN,DGINI) ;Look-up income relation
46 ; Add a new entry if one is not found
47 ; Input -- DFN Patient file IEN
48 ; DGINI Individual Annual Income IEN
49 ; Output -- Income Relation IEN
50 N DGIRI
51 S DGIRI=+$O(^DGMT(408.22,"AIND",DGINI,0))
52 I '$D(^DGMT(408.22,DGIRI,0)) S DGIRI=$$ADDIR(DFN,DGINI)
53GETIRQ Q $S(DGIRI>0:DGIRI,1:-1)
54 ;
55ADDIR(DFN,DGINI) ;Add a new income relation entry
56 ; Input -- DFN Patient file IEN
57 ; DGINI Individual Annual Income IEN
58 ; Output -- New Income Relation IEN
59 N DA,DD,DGIRI,DIC,DIK,DINUM,DLAYGO,DO,X,Y
60 S X=DFN,(DIC,DIK)="^DGMT(408.22,",DIC(0)="L",DLAYGO=408.22
61 D FILE^DICN S DGIRI=+Y
62 I DGIRI>0 L +^DGMT(408.22,DGIRI) S $P(^DGMT(408.22,DGIRI,0),"^",2)=DGINI,DA=DGIRI D IX1^DIK L -^DGMT(408.22,DGIRI)
63ADDIRQ Q $S(DGIRI>0:DGIRI,1:-1)
Note: See TracBrowser for help on using the repository browser.