source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMTU22.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1DGMTU22 ;ALB/CAW - COPY PRIOR YEAR INCOME INFORMATION; 6/18/92
2 ;;5.3;Registration;**33,45,624**;Aug 13, 1993
3 ;
4COPY(DFN,DGDT,DGMTI) ;
5 ; Input:
6 ; DFN - Patient IFN
7 ; DGDT - Date passed in where you want the prior years
8 ; income data to be copied into the last year
9 ; Ex. If DGDT is 6/30/92 the income from 1990 can
10 ; be optionally copied into 1991 if available.
11 ; DGMTI - Current MT IEN (optional)
12 ; Output:
13 ; Y - 0 not copied
14 ; 1 copied
15 ; -1 timed out or ^
16 N DGIN1,DGMT,DGPRI,DGFL,DGLY,DGLST,DGPY,DGI,DGINI,DGIRI,DGERR,DGREL,DGINC,DGINR,DGDEP,DEP,DGMTS,DGMTD
17 D INIT I Y'>0 W !,"Cannot copy information. Either there is no prior year income",!,"or there is income already on file for this year." H 2 G COPYQ
18 D ASK I Y'>0 W !,"Cannot copy information. Either there is no prior year income",!,"or there is income already on file for this year." H 2 G COPYQ
19 D STUFF
20COPYQ ;
21 K DTOUT Q
22INIT ; Init
23 D NEW^DGRPEIS1 I DGPRI'>0 S Y=0 G INITQ ; obtain pt's relation IEN
24 S DGLY=$$LYR^DGMTSCU1(DGDT),DGPY=$$LYR^DGMTSCU1(DGLY)
25 S DGLST=$$LST^DGMTU(DFN,DGDT-1) I DGLST']"" S Y=1 G INITQ
26 F DGI=4,5,15 I $P(^DGMT(408.31,+DGLST,0),U,DGI)["-" W !,"Previous year data contains a negative amount. Data cannot be copied." H 3 S Y=0 G INITQ
27 S Y=1
28INITQ Q
29ASK ; Can user copy?
30 N DGINR S Y=1
31 I '$D(^DGMT(408.21,"AI",+DGPRI,-DGPY)) S Y=0 Q
32 I $D(^DGMT(408.21,"AI",+DGPRI,-DGLY)) D
33 .S Y=$$NOBUCKS(DFN,DGDT)
34 Q
35 ;
36STUFF ; Copy infomation into last year
37 ;
38 ; Get prior year info IENs
39 I $G(DGMTI) N DGMT S DGMT=$$LST^DGMTU(DFN,$P(^DGMT(408.31,DGMTI,0),U)),DGMT=+$$LST^DGMTU(DFN,($P(DGMT,U,2)-1))
40 N Y D ALL^DGMTU21(DFN,"VSD",DGLY,"IPR",$G(DGMT))
41 ; Save prior year info
42 N DGCNT,DGPRTY
43 S DGCNT=0 F DGPRTY="V","S","D" I $D(DGREL(DGPRTY)) D
44 .I "D"[DGPRTY F S DGCNT=$O(DGREL(DGPRTY,DGCNT)) Q:'DGCNT D SET(DFN,DGDT,+DGREL(DGPRTY,DGCNT),+$G(DGINC(DGPRTY,DGCNT)),+$G(DGINR(DGPRTY,DGCNT)),$G(DGMTI))
45 .I "SV"[DGPRTY D SET(DFN,DGDT,+DGREL(DGPRTY),+$G(DGINC(DGPRTY)),+$G(DGINR(DGPRTY)),+$G(DGMTI))
46 Q
47SET(DFN,DGDT,DGPRI,DGPINI,DGPINR,DGMTI) ; Create last year IENs
48 ;
49 N DGERR,DGINI,DGIRI,DGMT,I,DGGRS
50 F I=0:1:2 S DGMT(I)=$G(^DGMT(408.21,DGPINI,I))
51 S DGMT(3)=$G(^DGMT(408.22,DGPINR,0))
52 D GETIENS^DGMTU2(DFN,DGPRI,DGDT) G SETQ:DGERR
53 ; Set info into global and index
54 S $P(^DGMT(408.22,+DGIRI,0),U,3,99)=$P(DGMT(3),U,3,99)
55 I $G(DGMTI) S ^DGMT(408.22,+DGIRI,"MT")=+DGMTI
56 S DIK="^DGMT(408.22,",DA=DGIRI D IX^DIK K DA,DIK
57 S $P(^DGMT(408.21,+DGINI,0),U,3,99)=$P(DGMT(0),U,3,99)
58 F I=1:1:2 I DGMT(I)'="" S ^DGMT(408.21,+DGINI,I)=DGMT(I)
59 S DGGRS=$P(DGMT(1),U,12) ;dg624 - preserve gross from 'AGME101' xref
60 S DIK="^DGMT(408.21,",DA=DGINI D IX^DIK K DA,DIK
61 D:+DGGRS ;dg624 - if gross, restore it & force recalc of adjusted
62 . S $P(^DGMT(408.21,+DGINI,1),U,12)=DGGRS
63 . S $P(^DGMT(408.21,+DGINI,1),U,1)=""
64SETQ Q
65NOBUCKS(DFN,DGDT) ; Used by Income Screen Checks if BOTH
66 ; NO meaningful Income Data for Prior Year
67 ; AND there is data for Year before Prior Year
68 ; 2=YES (but some edit/entry in 408.22),1=YES & 0=NO
69 ; ** REQUIRES DGINR("V")
70 N DGCURR,DGPRIEN,DGPRIOR,DGPY,DGLY,DGIAI,DGIR,DGY,DGINP
71 I $G(DGNOCOPY) S DGY=0 G QTNB
72 S:'$D(DGDT) DGDT=DT
73 S DGLY=$E(DGDT,1,3)_"0000"-10000,DGPY=DGLY-10000
74 S (DGPRIOR,DGCURR)=0
75 F DGPRIEN=0:0 S DGPRIEN=$O(^DGPR(408.12,"B",DFN,DGPRIEN)) Q:'DGPRIEN D
76 .S:$D(^DGMT(408.21,"AI",+DGPRIEN,-DGPY)) DGPRIOR=DGPRIOR+1
77 .S DGIAI=$$IAI^DGMTU3(+DGPRIEN,DGLY)
78 .I DGIAI]"" D
79 ..S DGCURR=DGCURR+$S($P($G(^DGMT(408.21,DGIAI,0)),U,8,18)'?."^":1,($P($G(^(1)),U,1,3)]""):1,($P($G(^(2)),U,1,5)]""):1,1:0)
80 ..;S DGINP=$O(^DGMT(408.22,"AIND",+DGIAI,"")) I $P($G(^DGMT(408.22,+DGINP,"MT")),U) S DGCURR=DGCURR+1
81 I 'DGPRIOR!DGCURR S DGY=0 G QTNB
82 S DGIR=$G(^DGMT(408.22,+$G(DGINR("V")),0))
83 S DGY=$S($P(DGIR,U,5)]"":2,($P(DGIR,U,13)]""):2,1:1)
84QTNB Q DGY
Note: See TracBrowser for help on using the repository browser.