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

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1DGRRPSD3 ; ALB/SGG - rtnDGRR PatientServices Demographics Tertiary ;09/30/03 ; Compiled November 4, 2003 12:01:00
2 ;;5.3;Registration;**557**;Aug 13, 1993
3 ;
4 ;
5DOC ;<DataSet Name='TertiaryDemographics'
6 ;
7 ;
8 ;
9 ; NAME COMPONENTS
10 ;.092 PLACE OF BIRTH [CITY] (F), [0;11]
11 ;.093 PLACE OF BIRTH [STATE] (P5'), [0;12]
12 ;.096 WHO ENTERED PATIENT (P200'I), [0;15]
13 ; WHO ENTERED PATIENT VPID FROM #200
14 ;.097 DATE ENTERED INTO FILE (D), [0;16]
15 ;.2401 FATHER'S NAME (FX), [.24;1]
16 ;.2402 MOTHER'S NAME (FX), [.24;2]
17 ;.2403 MOTHER'S MAIDEN NAME (FaX), [.24;3]
18 ;.07 OCCUPATION (F), [0;7]
19 ; MULTIPLE BIRTH INDICATOR NEEDS SORTED $P(^DPT(PTID,"MPIMB"),"^").
20 ;
21 ;1 ALIAS (Multiple-2.01), [.01;0]
22 ; .01 ALIAS (MFX), [0;1]
23 ; 1 ALIAS SSN (F), [0;2]
24 ;
25GETPSARY(PSARRAY) ;
26 NEW CNT
27 SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='TertiaryDemographics'"
28 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Last^"_$$LAST()
29 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^First^"_$$FIRST()
30 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Middle^"_$$MIDDLE()
31 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Prefix^"_$$PREFIX()
32 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Suffix^"_$$SUFFIX()
33 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Degree^"_$$DEGREE()
34 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^CityOfBirth^"_$$CITYOB()
35 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^StateOfBirth^"_$$STATEOB()
36 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WhoEnteredPatientVPID^"_$$WHOVPID()
37 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WhoEnteredPatient^"_$$ENTBYWHO()
38 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DatePatientEntered^"_$$ENTDATE()
39 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^FathersName^"_$$DADNAME()
40 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MothersName^"_$$MOMNAME()
41 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MothersMaidenName^"_$$MADNAME()
42 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Occupation^"_$$OCCUPAT()
43 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MultipleBirthIndicator^"_$$MULTIBI()
44 SET CNT=$G(CNT)+1,PSARRAY(CNT)=">"
45 DO ALISINFO
46 SET CNT=$G(CNT)+1,PSARRAY(CNT)="</DataSet>"_"^^^1"
47 QUIT
48 ;
49LAST() QUIT $P(GLOB("NAME"),"^",1)
50 ;
51FIRST() QUIT $P(GLOB("NAME"),"^",2)
52 ;
53MIDDLE() QUIT $P(GLOB("NAME"),"^",3)
54 ;
55PREFIX() QUIT $P(GLOB("NAME"),"^",5)
56 ;
57SUFFIX() QUIT $P(GLOB("NAME"),"^",4)
58 ;
59DEGREE() QUIT $P(GLOB("NAME"),"^",6)
60 ;
61CITYOB() QUIT $P(GLOB(0),"^",11)
62 ;
63STATEOB() ;
64 NEW DATA
65 SET DATA=$P(GLOB(0),"^",12)
66 IF DATA'="" SET DATA=$P($G(^DIC(5,DATA,0)),"^",2)
67 QUIT DATA
68 ;
69ENTBYWHO() ;
70 NEW DATA
71 SET DATA=$P(GLOB(0),"^",15)
72 IF DATA'="" SET DATA=$P($G(^VA(200,DATA,0)),"^",1)
73 QUIT DATA
74 ;
75WHOVPID() ;
76 QUIT $$VPID^XUPS($P(GLOB(0),"^",15))
77 ;
78ENTDATE() QUIT $P(GLOB(0),"^",16)
79 ;
80DADNAME() QUIT $P(GLOB(.24),"^",1)
81 ;
82MOMNAME() QUIT $P(GLOB(.24),"^",2)
83 ;
84MADNAME() QUIT $P(GLOB(.24),"^",3)
85 ;
86OCCUPAT() QUIT $P(GLOB(0),"^",7)
87 ;
88MULTIBI() ;
89 NEW DATA
90 SET DATA=$P($G(^DPT(PTID,"MPIMB")),"^",1)
91 SET DATA=$S(DATA="Y":"YES",DATA="N":"NO",1:"")
92 QUIT DATA
93 ;
94ALISINFO ;
95 NEW ALISCNT,ROWCNT,ALIS,ALISSSN
96 SET ALISCNT=0,ROWCNT=0
97 FOR SET ALISCNT=$O(^DPT(PTID,.01,ALISCNT)) QUIT:(ALISCNT<1) DO
98 .SET ALIS=$P($G(^DPT(PTID,.01,ALISCNT,0)),"^",1)
99 .SET ALISSSN=$P($G(^DPT(PTID,.01,ALISCNT,0)),"^",2)
100 .IF +$L(ALIS_ALISSSN) DO
101 ..SET ROWCNT=ROWCNT+1
102 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="<Alias Row='"_ROWCNT_"'"
103 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Alias^"_ALIS_"^^ALIAS^"_ROWCNT
104 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^SSN^"_ALISSSN_"^^ALIAS^"_ROWCNT
105 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="></Alias>"
106 IF ROWCNT=0 DO
107 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="<Alias Row='1' Alias='' SSN=''></Alias>"
108 QUIT
Note: See TracBrowser for help on using the repository browser.