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

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1DGDEP3 ;ALB/CAW,ERC - Dependents display ; 11/3/05 9:42am
2 ;;5.3;Registration;**45,624,653**;Aug 13, 1993;Build 2
3 ;
4SELF(INCPER,NAME,RELATE,ACT,DGMTI,CNT) ; Display information concerning veteran
5 ;
6 S DGX="",DGX=$$SETSTR^VALM1(CNT,DGX,3,3)
7 I $G(DGMTI),INCPER,($P($G(^DGMT(408.22,+INCPER,"MT")),U)=DGMTI) S DGX=$$SETSTR^VALM1("*",DGX,5,1)
8 S DGX=$$SETSTR^VALM1(NAME,DGX,9,22)
9 S DGX=$$SETSTR^VALM1($P($G(^DG(408.11,RELATE,0)),U),DGX,32,30)
10 S DGX=$$SETSTR^VALM1($S($P(ACT,U,2)=1:"*",1:""),DGX,65,1)
11 S:RELATE=2 DGX=$$SETSTR^VALM1($S(+$$ADDCHK(INCPER)=1:"*",1:""),DGX,73,1)
12 D SET^DGDEP(DGX)
13 ;
14 I RELATE=2 D
15 . S DGX="",DGX=$$SETSTR^VALM1($P(DGDEP,"^",5),DGX,9,14)
16 . ;if a Pseudo SSN need Pseudo SSN Reason - DG*5.3*653, ERC
17 . I $P(DGDEP,U,5)["P" D
18 . . S DGX=$$SETSTR^VALM1("PSSN Reason: ",DGX,32,15)
19 . . S DGX=$$SETSTR^VALM1($P(DGDEP,U,10),DGX,45,30)
20 . . ;D SET^DGDEP(DGX)
21 . D SET^DGDEP(DGX)
22 ;
23 Q:RELATE=2
24 S INCPER=^DGMT(408.22,INCPER,0)
25 S DGX="",DGX=$$SETSTR^VALM1("Married Last Year: ",DGX,18,19)
26 S DGX=$$SETSTR^VALM1($S($P(INCPER,U,5):"Yes",$P(INCPER,U,5)="":"Unanswered",1:"No"),DGX,38,10)
27 D SET^DGDEP(DGX)
28 ;
29 Q:'$G(DGMTI)
30 I $P(INCPER,U,5)=1 D
31 .S DGX="",DGX=$$SETSTR^VALM1("Lived with Spouse: ",DGX,18,19)
32 .S DGX=$$SETSTR^VALM1($S($P(INCPER,U,6):"Yes",$P(INCPER,U,6)="":"Unanswered",1:"No"),DGX,38,10)
33 .D SET^DGDEP(DGX)
34 ;
35 I $P(INCPER,U,6)=0 D
36 .S DGX="",DGX=$$SETSTR^VALM1("Amount Contributed: ",DGX,17,19)
37 .S DGX=$$SETSTR^VALM1($S($P(INCPER,U,7)]"":$P(INCPER,U,7),1:"Unanswered"),DGX,38,10)
38 .D SET^DGDEP(DGX)
39 Q
40 ;
41CHILD(INCPER,NAME,RELATE,ACT,DGMTI,DGMTACT,CNT) ; Display information concerning dependents
42 ;
43 S DGX="",DGX=$$SETSTR^VALM1(CNT,DGX,3,3)
44 I $G(DGMTI),INCPER,($P($G(^DGMT(408.22,+INCPER,"MT")),U)=DGMTI) S DGX=$$SETSTR^VALM1("*",DGX,5,1)
45 S DGX=$$SETSTR^VALM1(NAME,DGX,9,22)
46 S DGX=$$SETSTR^VALM1($P($G(^DG(408.11,RELATE,0)),U),DGX,32,30)
47 S DGX=$$SETSTR^VALM1($S($P(ACT,U,2)=1:"*",1:""),DGX,65,1)
48 S DGX=$$SETSTR^VALM1($S(+$$ADDCHK(INCPER)=1:"*",1:""),DGX,73,1)
49 D SET^DGDEP(DGX)
50 ;
51 S DGX="",DGX=$$SETSTR^VALM1($P(DGDEP,"^",5),DGX,9,14)
52 I $P(DGDEP,U,5)["P" D
53 . S DGX=$$SETSTR^VALM1("PSSN Reason: ",DGX,32,15)
54 . S DGX=$$SETSTR^VALM1($P(DGDEP,U,10),DGX,45,30)
55 D SET^DGDEP(DGX)
56 ;
57 Q:'$G(DGMTI)!('$P($G(^DG(408.11,RELATE,0)),U,4))
58 S INCPER=^DGMT(408.22,INCPER,0)
59 S DGX="",DGX=$$SETSTR^VALM1("Incapable of Self-support: ",DGX,10,27)
60 S DGX=$$SETSTR^VALM1($S($P(INCPER,U,9):"Yes",$P(INCPER,U,9)="":"Unanswered",1:"No"),DGX,38,10)
61 D SET^DGDEP(DGX)
62 ;
63 ;* DG*5.3*624
64 S DGX="",DGX=$$SETSTR^VALM1("Child 18 to 23. Attended School: ",DGX,4,33)
65 S DGX=$$SETSTR^VALM1($S($P(INCPER,U,18):"Yes",$P(INCPER,U,18)="":"Unanswered",1:"No"),DGX,38,10)
66 D SET^DGDEP(DGX)
67 ;
68 S DGX="",DGX=$$SETSTR^VALM1("Child lived with you: ",DGX,15,22)
69 S DGX=$$SETSTR^VALM1($S($P(INCPER,U,6):"Yes",$P(INCPER,U,6)="":"Unanswered",1:"No"),DGX,38,10)
70 D SET^DGDEP(DGX)
71 ;
72 S DGX="",DGX=$$SETSTR^VALM1("Child Support: ",DGX,22,15)
73 S DGX=$$SETSTR^VALM1($S($P(INCPER,U,6)=1:"N/A",$P(INCPER,U,10)=1:"Yes",$P(INCPER,U,10)="":"Unanswered",1:"No"),DGX,38,10)
74 D SET^DGDEP(DGX)
75 ;
76 ;* DG*5.3*624
77 S DGX="",DGX=$$SETSTR^VALM1("Amount contributed: ",DGX,17,20)
78 S DGX=$$SETSTR^VALM1($S($P(INCPER,U,10)'=1:"N/A",($P(INCPER,U,19)'="0")&($P(INCPER,U,19)'=""):$P(INCPER,U,19),$P(INCPER,U,19)="":"Unanswered",1:"0"),DGX,38,10)
79 D SET^DGDEP(DGX)
80 ;
81 S DGX="",DGX=$$SETSTR^VALM1("Child Has Income: ",DGX,19,18)
82 S DGX=$$SETSTR^VALM1($S($P(INCPER,U,11)=1:"Yes",$P(INCPER,U,11)="":"Unanswered",1:"No"),DGX,38,10)
83 D SET^DGDEP(DGX)
84 ;
85 S DGX="",DGX=$$SETSTR^VALM1("Income Available: ",DGX,19,18)
86 S DGX=$$SETSTR^VALM1($S($P(INCPER,U,11)=0:"N/A",$P(INCPER,U,12)=1:"Yes",$P(INCPER,U,12)="":"Unanswered",1:"No"),DGX,38,10)
87 D SET^DGDEP(DGX)
88CHILDQ Q
89 ;
90ADDCHK(INCPER) ; Indicates existence of any dependent address
91 ; Input:
92 ; INCPER - Pointer to dep. entry in Income Relation file (408.22)
93 ;
94 ; Output:
95 ; both address and phone^address^phone
96 ; KEY:
97 ; 0 - No data exists for the dependent in 408.13
98 ; 1 - Data exists for the dependent in 408.13
99 ;
100 ; 1^1^1 - Address and Phone data exist for dependent
101 ; 0^1^0 - Address only exists for dependent
102 ; 0^0^1 - Phone only exists for dependent
103 ; 0^0^0 - Neither Phone nor Address data exists for dependent
104 ;
105 N ADDCKVAL,INDAIIEN,PRIEN,IPIEN
106 S ADDCKVAL="0^0^0"
107 S INDAIIEN=$P($G(^DGMT(408.22,INCPER,0)),"^",2)
108 S PRIEN=$P($G(^DGMT(408.21,INDAIIEN,0)),"^",2)
109 S IPIEN=$P($G(^DGPR(408.12,PRIEN,0)),"^",3)
110 I IPIEN["DGPR(408.13" DO
111 . S IPIEN=$P(IPIEN,";",1)
112 . I $P($G(^DGPR(408.13,IPIEN,1)),"^",2)]"" S $P(ADDCKVAL,U,1,2)="1^1"
113 . I $P($G(^DGPR(408.13,IPIEN,1)),"^",3)]"" S $P(ADDCKVAL,U,1,2)="1^1"
114 . I $P($G(^DGPR(408.13,IPIEN,1)),"^",4)]"" S $P(ADDCKVAL,U,1,2)="1^1"
115 . I $P($G(^DGPR(408.13,IPIEN,1)),"^",5)]"" S $P(ADDCKVAL,U,1,2)="1^1"
116 . I $P($G(^DGPR(408.13,IPIEN,1)),"^",6)]"" S $P(ADDCKVAL,U,1,2)="1^1"
117 . I $P($G(^DGPR(408.13,IPIEN,1)),"^",7)]"" S $P(ADDCKVAL,U,1,2)="1^1"
118 . I $P($G(^DGPR(408.13,IPIEN,1)),"^",8)]"" S $P(ADDCKVAL,U,3)="1"
119 Q ADDCKVAL
Note: See TracBrowser for help on using the repository browser.