source: qrda/C0Q/trunk/p/C0QMU122.m@ 1751

Last change on this file since 1751 was 1501, checked in by Sam Habiel, 12 years ago

Latest routines; T11 copy

File size: 1.2 KB
RevLine 
[1501]1C0QMU122 ;VEN/SMH - Patient Reminder List, cont. again ; 7/31/12 12:33pm
2 ;;1.0;C0Q;;May 21, 2012;Build 63
3 ;
4 ; Licensed under package license.
5 ;
6DEMO ; patient demographics
7 K PTDOB
8 N PTNAME,PTSEX,PTHRN,PTRLANG,PTLANG,RACE,RACEDSC,ETHN,ETHNDSC,RB
9 S PTNAME=$P(^DPT(DFN,0),U) ;patient name
10 S PTDOB=$$FMTE^XLFDT($P($G(^DPT(DFN,0)),U,3)) ;date of birth
11 S PTSEX=$P($G(^DPT(DFN,0)),U,2) ;patient sex
12 D PID^VADPT ;VADPT call to grab PISD based on PT Eligibility
13 S PTHRN=$P($G(VA("PID")),U) ;health record number
14 S PTRLANG=$P($G(^DPT(DFN,256000)),U) ;ptr to language file
15 I $G(PTRLANG)'="" S PTLANG=$P(^DI(.85,PTRLANG,0),U) ;PLS extrnl
16 S RACE=""
17 F D Q:RACE=""
18 . S RACE=$O(^DPT(DFN,.02,"B",RACE)) ;race code IEN
19 . Q:'RACE
20 . S RACEDSC=$P($G(^DIC(10,RACE,0)),U) ;race description
21 S ETHN=""
22 F D Q:ETHN=""
23 . S ETHN=$O(^DPT(DFN,.06,"B",ETHN)) ;ethnicity IEN
24 . Q:'ETHN
25 . S ETHNDSC=$P($G(^DIC(10.2,ETHN,0)),U) ;ethnincity description
26 S RB=$P($G(^DPT(DFN,.101)),U) ;room and bed
27 N DEMOYN S DEMOYN=1
28 I $G(PTSEX)="" S DEMOYN=0
29 I $G(PTDOB)="" S DEMOYN=0
30 I $G(PTHRN)="" S DEMOYN=0
31 I $G(PTLANG)="" S DEMOYN=0
32 I $G(RACEDSC)="" S DEMOYN=0
33 I $G(ETHNDSC)="" S DEMOYN=0
34 I DEMOYN S C0QLIST(ZYR_"HasDemographics",DFN)=""
35 E S C0QLIST(ZYR_"FailedDemographics",DFN)=""
36 Q
37 ;
Note: See TracBrowser for help on using the repository browser.