| 1 | EASECU2 ;ALB/LBD - Income Utilities ;14 AUG 2001
|
|---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5**;Mar 15, 2001
|
|---|
| 3 | ;
|
|---|
| 4 | GETIENS(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 | ;
|
|---|
| 16 | GETIN(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)
|
|---|
| 27 | GETINQ Q $S(DGINI>0:DGINI,1:-1)
|
|---|
| 28 | ;
|
|---|
| 29 | ADDIN(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)
|
|---|
| 43 | ADDINQ Q $S(DGINI>0:DGINI,1:-1)
|
|---|
| 44 | ;
|
|---|
| 45 | GETIR(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)
|
|---|
| 53 | GETIRQ Q $S(DGIRI>0:DGIRI,1:-1)
|
|---|
| 54 | ;
|
|---|
| 55 | ADDIR(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)
|
|---|
| 63 | ADDIRQ Q $S(DGIRI>0:DGIRI,1:-1)
|
|---|
