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

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1DGRRPSD2 ; ALB/SGG - rtnDGRR PatientServices Demographics Secondary ;09/30/03 ; Compiled December 9, 2003 15:23:28
2 ;;5.3;Registration;**557**;Aug 13, 1993
3 ;
4DOC ;<DataSet Name='SecondaryDemographics'
5 ;
6 ;FROM: ^DGSL(38.1,
7 ;3 SECURITY ASSIGNED BY (RP200'), [0;3]
8 ;4 DATE/TIME SECURITY ASSIGNED (RD), [0;4]
9 ;5 SECURITY SOURCE (F), [0;5]
10 ;
11 ;FROM: ^DPT(PTID
12 ; RACE INFORMATION (Multiple-2.02), [.02;0]
13 ; .01 RACE INFORMATION (M*P10'X), [0;1]
14 ; .02 METHOD OF COLLECTION (RP10.3'), [0;2]
15 ;
16 ;.352 DEATH ENTERED BY (P200'), [.35;2]
17 ;
18 ;6 ETHNICITY INFORMATION (Multiple-2.06), [.06;0]
19 ; .01 ETHNICITY INFORMATION (*P10.2'X), [0;1]
20 ; .02 METHOD OF COLLECTION (RP10.3'), [0;2]
21 ;
22 ;Primary Care Provider - Use $$NMPCPR^SCAPMCU2(PTID,DT,1) API to
23 ; retrieve Primary Care Provider. Call VPID^XUPS API to
24 ; convert DUZ to VPID.
25 ;
26GETPSARY(PSARRAY) ;
27 NEW CNT
28 SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='SecondaryDemographics'"
29 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^SecurityAssignedBy^"_$$SECASGBY()
30 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DateTimeSecurityAssigned^"_$$DTSECASG()
31 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^SecuritySource^"_$$SECSOURC()
32 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PrimaryCareProvider^"_$$PCP()
33 DO ETHNINFO
34 DO RACEINFO
35 SET CNT=$G(CNT)+1,PSARRAY(CNT)="</DataSet>"_"^^^1"
36 QUIT
37 ;
38SECASGBY() ;
39 NEW DATA
40 SET DATA=$P(GLOB(38.1),"^",3)
41 IF DATA'="" S DATA=$P($G(^VA(200,DATA,0)),"^",1)
42 QUIT DATA
43 ;
44DTSECASG() ;
45 QUIT $P(GLOB(38.1),"^",4)
46 ;
47SECSOURC() ;
48 QUIT $P(GLOB(38.1),"^",5)
49 ;
50DODENTBY() ;
51 NEW DATA
52 SET DATA=$P(GLOB(.35),"^",2)
53 IF DATA'="" SET DATA=$P($G(^VA(200,DATA,0)),"^",1)
54 QUIT DATA
55 ;
56DODVPID() ;
57 ;QUIT "200#ROOT"_$P(GLOB(.35),"^",2)
58 QUIT $$VPID^XUPS($P(GLOB(.35),"^",2))
59 ;
60PCP() ;Primary Care Provider
61 ; get the PCP's IEN and convert to VPID (primary care physician)
62 ;
63 N PATSPCP,PCPIEN,PCPVPID
64 SET PATSPCP=$$NMPCPR^SCAPMCU2(PTID,DT,1)
65 SET PCPIEN=$P(PATSPCP,"^",1)
66 SET PCPVPID=$$VPID^XUPS(+PCPIEN)
67 QUIT PCPVPID
68 ;
69ETHNINFO ;
70 NEW ETHCNT,ROWCNT,ETHNIC,METHOD
71 SET ETHCNT=0,ROWCNT=0
72 FOR SET ETHCNT=$O(^DPT(PTID,.06,ETHCNT)) QUIT:(ETHCNT<1) DO
73 .SET ETHNIC=$P($G(^DPT(PTID,.06,ETHCNT,0)),"^",1)
74 .SET METHOD=$P($G(^DPT(PTID,.06,ETHCNT,0)),"^",2)
75 .IF ETHNIC'="" DO
76 ..SET ROWCNT=ROWCNT+1
77 ..SET ETHNIC=$P($G(^DIC(10.2,ETHNIC,0)),"^",1)
78 ..IF METHOD'="" SET METHOD=$P(^DIC(10.3,METHOD,0),"^",1)
79 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="><Ethnicity Row='"_ROWCNT_"'"
80 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Ethnicity^"_ETHNIC_"^^ETHNIC^"_ROWCNT
81 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MethodOfCollection^"_METHOD_"^^ETHNIC^"_ROWCNT
82 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="></Ethnicity>"
83 IF ROWCNT=0 DO
84 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="><Ethnicity Row='1' Ethnicity='' MethodOfCollection=''></Ethnicity>"
85 QUIT
86 ;
87RACEINFO ;
88 NEW RACECNT,ROWCNT,RACE,METHOD
89 SET RACECNT=0,ROWCNT=0
90 FOR SET RACECNT=$O(^DPT(PTID,.02,RACECNT)) QUIT:(RACECNT<1) DO
91 .SET RACE=$P($G(^DPT(PTID,.02,RACECNT,0)),"^",1)
92 .SET METHOD=$P($G(^DPT(PTID,.02,RACECNT,0)),"^",2)
93 .IF RACE'="" DO
94 ..SET ROWCNT=ROWCNT+1
95 ..SET RACE=$P($G(^DIC(10,RACE,0)),"^",1)
96 ..IF METHOD'="" SET METHOD=$P(^DIC(10.3,METHOD,0),"^",1)
97 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="<Race Row='"_ROWCNT_"'"
98 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Race^"_RACE_"^^RACE^"_ROWCNT
99 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MethodOfCollection^"_METHOD_"^^RACE^"_ROWCNT
100 ..SET CNT=$G(CNT)+1,PSARRAY(CNT)="></Race>"
101 IF ROWCNT=0 DO
102 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="<Race Row='1' Race='' MethodOfCollection=''></Race>"
103 QUIT
Note: See TracBrowser for help on using the repository browser.