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

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

initial load of FOIAVistA 6/30/08 version
File size: 5.8 KB
Line 
1VADPT1 ;ALB/MRL/MJK - PATIENT VARIABLES ; 08 DEC 1988 ; 11/9/04 6:17pm
2 ;;5.3;Registration;**415,489,516,614**;Aug 13, 1993
31 ;Demographic [DEM]
4 N W,Z,NODE
5 ;
6 ; -- name [1 - NM]
7 S VAX=^DPT(DFN,0),@VAV@($P(VAS,"^",1))=$P(VAX,"^")
8 ;
9 ; -- ssn [2 - SS]
10 S Z=$P(VAX,"^",9) S:Z]"" @VAV@($P(VAS,"^",2))=Z_$S(Z]"":"^"_$E(Z,1,3)_"-"_$E(Z,4,5)_"-"_$E(Z,6,10),1:"")
11 ;
12 ; -- date of birth [2 - DB]
13 S Z=$P(VAX,"^",3),Y=Z I Y]"" X ^DD("DD") S @VAV@($P(VAS,"^",3))=Z_"^"_Y
14 ;
15 ; -- age [4 - AG]
16 S W=$S('$D(^DPT(DFN,.35)):"",'^(.35):"",1:+^(.35)) S Y=$S('W:DT,1:W) S:Z]"" @VAV@($P(VAS,"^",4))=$E(Y,1,3)-$E(Z,1,3)-($E(Y,4,7)<$E(Z,4,7))
17 ;
18 ; -- expired date [6 - EX]
19 S (Y,Z)=W X:Y]"" ^DD("DD") S:Z]"" @VAV@($P(VAS,"^",6))=Z_"^"_Y
20 ;
21 ; -- sex [5 - SX]
22 S Z=$P(VAX,"^",2) S:Z]"" @VAV@($P(VAS,"^",5))=Z_"^"_$S(Z="M":"MALE",Z="F":"FEMALE",1:"") K Z
23 ;
24 ; -- remarks [7 - RE]
25 S @VAV@($P(VAS,"^",7))=$P(VAX,"^",10)
26 ;
27 ; -- historic race [8 - RA]
28 S Z=$P(VAX,"^",6),@VAV@($P(VAS,"^",8))=Z_$S($D(^DIC(10,+Z,0)):"^"_$P(^(0),"^"),1:"")
29 ;
30 ; -- religion [9 - RP]
31 S Z=$P(VAX,"^",8),@VAV@($P(VAS,"^",9))=Z_$S($D(^DIC(13,+Z,0)):"^"_$P(^(0),"^"),1:"")
32 ;
33 ; -- marital status [10 - MS]
34 S Z=$P(VAX,"^",5),@VAV@($P(VAS,"^",10))=Z_$S($D(^DIC(11,+Z,0)):"^"_$P(^(0),"^"),1:"")
35 ;
36 ; -- ethnicity [11 - ET]
37 S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.06,X)) Q:'X D
38 .S NODE=$G(^DPT(DFN,.06,X,0)),Z=$P(NODE,"^",1) I Z D
39 ..S @VAV@($P(VAS,"^",11),Y)=Z_"^"_$P($G(^DIC(10.2,Z,0)),"^",1)
40 ..; -- collection method
41 ..S Z=$P(NODE,"^",2) I Z D
42 ...S @VAV@($P(VAS,"^",11),Y,1)=Z_"^"_$P($G(^DIC(10.3,Z,0)),"^",1)
43 S @VAV@($P(VAS,"^",11))=Y-1
44 ;
45 ; -- race [12 - RC]
46 S X=0 F Y=1:1 S X=+$O(^DPT(DFN,.02,X)) Q:'X D
47 .S NODE=$G(^DPT(DFN,.02,X,0)),Z=$P(NODE,"^",1) I Z D
48 ..S @VAV@($P(VAS,"^",12),Y)=Z_"^"_$P($G(^DIC(10,Z,0)),"^",1)
49 ..; -- collection method
50 ..S Z=$P(NODE,"^",2) I Z D
51 ...S @VAV@($P(VAS,"^",12),Y,1)=Z_"^"_$P($G(^DIC(10.3,Z,0)),"^",1)
52 S @VAV@($P(VAS,"^",12))=Y-1
53 Q
54 ;
552 ;Other Patient Variables [OPD]
56 N W,Z
57 S VAX=^DPT(DFN,0)
58 ;
59 ; -- city of birth [1 - BC]
60 S @VAV@($P(VAS,"^",1))=$P(VAX,"^",11)
61 ;
62 ; -- state of birth [2 - BS]
63 S Z=$P(VAX,"^",12),@VAV@($P(VAS,"^",2))=Z_$S($D(^DIC(5,+Z,0)):"^"_$P(^(0),"^",1),1:"")
64 ;
65 ; -- occupation [6 - OC]
66 S @VAV@($P(VAS,"^",6))=$P(VAX,"^",7)
67 ;
68 ; -- names
69 S VAX=$S($D(^DPT(DFN,.24)):^(.24),1:"")
70 S @VAV@($P(VAS,"^",3))=$P(VAX,"^",1) ; father's [3 - FN]
71 S @VAV@($P(VAS,"^",4))=$P(VAX,"^",2) ; mother's [4 - MN]
72 S @VAV@($P(VAS,"^",5))=$P(VAX,"^",3) ; mother's maiden [5 - MM]
73 ;
74 ; -- employment status [7 - ES]
75 S VAX=$S($D(^DPT(DFN,.311)):^(.311),1:""),W="EMPLOYED FULL TIME^EMPLOYED PART TIME^NOT EMPLOYED^SELF EMPLOYED^RETIRED^ACTIVE MILITARY DUTY^UNKNOWN"
76 S Z=$P(VAX,"^",15),@VAV@($P(VAS,"^",7))=Z_$S(Z:"^"_$P(W,"^",Z),1:"")
77 Q
78 ;
793 ;Address [ADD]
80 S VABEG=$S($D(VATEST("ADD",9)):VATEST("ADD",9),1:DT),VAEND=$S($D(VATEST("ADD",10)):VATEST("ADD",10),1:DT)
81 I $S($D(VAPA("P")):1,'$D(^DPT(DFN,.121)):1,$P(^(.121),"^",9)'="Y":1,'$P(^(.121),"^",7):1,$P(^(.121),"^",7)>VABEG:1,'$P(^(.121),"^",8):0,1:$P(^(.121),"^",8)<VAEND) S VAX=$S($D(^DPT(DFN,.11)):^(.11),1:""),VAX(1)=0
82 E S VAX=$S($D(^DPT(DFN,.121)):^(.121),1:""),VAX(1)=1
83 F I=1:1:6 S VAZ=$P(VAX,"^",I),@VAV@($P(VAS,"^",I))=VAZ I I=5,$D(^DIC(5,+VAZ,0)) S VAZ=$P(^(0),"^"),@VAV@($P(VAS,"^",5))=@VAV@($P(VAS,"^",5))_"^"_VAZ
84 S VAZ=$S('VAX(1):$P(VAX,"^",7),1:$P(VAX,"^",11)) S:$D(^DIC(5,+$P(VAX,"^",5),1,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",7))=VAZ
85 S VAZIP4=$P(VAX,U,12)
86 S @VAV@($P(VAS,U,11))=VAZIP4_$S('$G(VAZIP4):"",($L(VAZIP4)=5):U_VAZIP4,1:U_$E(VAZIP4,1,5)_"-"_$E(VAZIP4,6,9))
87 ;DG*5.3*516
88 I $D(^DPT(DFN,.13)) S @VAV@($P(VAS,"^",8))=$P(^(.13),"^",1)
89 I 'VAX(1) G CA
90 S @VAV@($P(VAS,"^",8))=$P(VAX,"^",10)
91 F I=7,8 S VAZ=$P(VAX,"^",I),Y=VAZ X:Y]"" ^DD("DD") S @VAV@($P(VAS,"^",I+2))=VAZ_"^"_Y
92CA ;Confidential Address
93 I '$D(^DPT(DFN,.141)) G Q3
94 N VACAT,VAACT,VAACTDT,VATYP,VATYPNAM,VACAN
95 S VAX=$S($D(^DPT(DFN,.141)):^(.141),1:"")
96 S VAACTDT=$S($D(VAPA("CD")):VAPA("CD"),1:DT)
97 F I=1:1:6 S VAZ=$P(VAX,"^",I),@VAV@($P(VAS,"^",I+12))=VAZ D
98 .I I=5,$D(^DIC(5,+VAZ,0)) S VAZ=$P(^(0),"^"),@VAV@($P(VAS,"^",I+12))=@VAV@($P(VAS,"^",I+12))_"^"_VAZ Q
99 .I I=6,($G(VAZ)]"") S @VAV@($P(VAS,"^",I+12))=@VAV@($P(VAS,"^",I+12))_"^"_$S(($L(VAZ)=5):VAZ,1:$E(VAZ,1,5)_"-"_$E(VAZ,6,9))
100 S VAZ=$P(VAX,"^",11) S:$D(^DIC(5,+$P(VAX,"^",5),1,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",19))=VAZ
101 F I=7,8 S VAZ=$P(VAX,"^",I),Y=VAZ X:Y]"" ^DD("DD") S @VAV@($P(VAS,"^",I+13))=VAZ_"^"_Y
102 S VABEG=$P(VAX,"^",7),VAEND=$P(VAX,"^",8)
103 S @VAV@($P(VAS,"^",12))=1
104 I 'VABEG!(VABEG>VAACTDT)!(VAEND&(VAEND<VAACTDT)) S @VAV@($P(VAS,"^",12))=0
105 I $D(^DPT(DFN,.14)) D
106 .S VACAN="" F S VACAN=$O(^DPT(DFN,.14,VACAN)) Q:VACAN="" D
107 ..Q:'$D(^DPT(DFN,.14,VACAN,0))
108 ..S VATYP=$P(^DPT(DFN,.14,VACAN,0),"^",1),VAACT=$P(^DPT(DFN,.14,VACAN,0),"^",2)
109 ..S VACAT=$$GET1^DID(2.141,.01,"","POINTER","","DGERR")
110 ..S VATYPNAM="" F I=1:1 S VATYPNAM=$P(VACAT,";",I) Q:VATYPNAM="" D
111 ...I +VATYPNAM[VATYP S VATYPNAM=$P(VATYPNAM,":",2),@VAV@($P(VAS,"^",22),VATYP)=VATYP_"^"_VATYPNAM_"^"_VAACT
112Q3 K VABEG,VAEND,VAZIP4 Q
113 ;
1144 ;Other Address [OAD]
115 N VAZIP4
116 I $S('$D(VAOA("A")):1,VAOA("A")<1:1,VAOA("A")>6:1,1:0) S VAX=.21,VAOA("A")=7
117 E S VAX="."_$P("33^34^211^331^311^25","^",+VAOA("A"))
118 S VAX(1)=VAX,VAX=$S($D(^DPT(DFN,VAX(1))):^(VAX(1)),1:"") I VAX(1)=.25 S VAX=$P(VAX,"^",1)_"^^"_$P(VAX,"^",2,99)
119 S VAX(2)=0 F I=3,4,5,6,7,8 S VAX(2)=VAX(2)+1,@VAV@($P(VAS,"^",VAX(2)))=$P(VAX,"^",I)
120 S @VAV@($P(VAS,"^",7))="",@VAV@($P(VAS,"^",8))=$P(VAX,"^",9),VAX(2)=8
121 F I=1,2 S VAX(2)=VAX(2)+1,@VAV@($P(VAS,"^",VAX(2)))=$P(VAX,"^",I)
122 I "^.311^.25"[("^"_VAX(1)_"^") S @VAV@($P(VAS,"^",10))=""
123 S VAZ=@VAV@($P(VAS,"^",5)) I VAZ,$D(^DIC(5,+VAZ,0)) S VAZ(1)=$P(^(0),"^",1),@VAV@($P(VAS,"^",5))=VAZ_"^"_VAZ(1)
124 S VAZIP4=$P($G(^DPT(DFN,.22)),U,VAOA("A"))
125 S @VAV@($P(VAS,U,11))=VAZIP4_$S('$G(VAZIP4):"",($L(VAZIP4)=5):U_VAZIP4,1:U_$E(VAZIP4,1,5)_"-"_$E(VAZIP4,6,9))
126 Q
Note: See TracBrowser for help on using the repository browser.