source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTU2.m@ 623

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1DGMTU2 ;ALB/RMO - Income Utilities ;28 JAN 1992 11:00 am
2 ;;5.3;Registration;**33**;Aug 13, 1993
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,DGLY
23 S DGLY=$$LYR^DGMTSCU1(DGDT)
24 S DGINI=+$$IAI^DGMTU3(DGPRI,DGLY)
25 I '$D(^DGMT(408.21,DGINI,0)) S DGINI=$$ADDIN(DFN,DGPRI,DGLY)
26GETINQ Q $S(DGINI>0:DGINI,1:-1)
27 ;
28ADDIN(DFN,DGPRI,DGLY) ;Add a new individual annual income entry
29 ; Input -- DFN Patient file IEN
30 ; DGPRI Patient Relation IEN
31 ; DGLY Last Year
32 ; Output -- New Individual Annual Income IEN
33 N DA,DD,DGINI,DGNOW,DIC,DIK,DINUM,DLAYGO,DO,X,Y,%
34 D NOW^%DTC S DGNOW=%
35 S X=DGLY,(DIC,DIK)="^DGMT(408.21,",DIC(0)="L",DLAYGO=408.21
36 D FILE^DICN S DGINI=+Y
37 I DGINI>0 L +^DGMT(408.21,DGINI) S $P(^DGMT(408.21,DGINI,0),"^",2)=DGPRI,^("USR")=DUZ_"^"_DGNOW,DA=DGINI D IX1^DIK L -^DGMT(408.21,DGINI)
38ADDINQ Q $S(DGINI>0:DGINI,1:-1)
39 ;
40GETIR(DFN,DGINI) ;Look-up income relation
41 ; Add a new entry if one is not found
42 ; Input -- DFN Patient file IEN
43 ; DGINI Individual Annual Income IEN
44 ; Output -- Income Relation IEN
45 N DGIRI
46 S DGIRI=+$O(^DGMT(408.22,"AIND",DGINI,0))
47 I '$D(^DGMT(408.22,DGIRI,0)) S DGIRI=$$ADDIR(DFN,DGINI)
48GETIRQ Q $S(DGIRI>0:DGIRI,1:-1)
49 ;
50ADDIR(DFN,DGINI) ;Add a new income relation entry
51 ; Input -- DFN Patient file IEN
52 ; DGINI Individual Annual Income IEN
53 ; Output -- New Income Relation IEN
54 N DA,DD,DGIRI,DIC,DIK,DINUM,DLAYGO,DO,X,Y
55 S X=DFN,(DIC,DIK)="^DGMT(408.22,",DIC(0)="L",DLAYGO=408.22
56 D FILE^DICN S DGIRI=+Y
57 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)
58ADDIRQ Q $S(DGIRI>0:DGIRI,1:-1)
Note: See TracBrowser for help on using the repository browser.