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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1DGRRLUA ;alb/aas - Person Service Lookup gather patient data;2/15/2005
2 ;;5.3;Registration;**538**;Aug 13, 1993
3 ;
4 ;DGRRLUA created when DGRRLU exceeded maximum routine size
5 ;
6PTDATA(DFN,DGRRPCNT) ;
7 NEW I,DONE,LINE,ALIAS,NAME,PTNAME,DOB,SSN,TYPE,GENDER,ICN,PRIM,SC,SCPER,VET,WARD,ROOMBED,SENSITIV,DGEMP,PATSPCP,PCPIEN,PCPVPID,PCPNAME
8 IF DGRRPCNT>(MAXSIZE-1) DO MAXOUT QUIT
9 ;IF (MSCREEN'="") X MSCREEN I '$T Q
10 SET DGRRPCNT=DGRRPCNT+1
11 SET LINE="<patient number='"_DGRRPCNT_"' dfn='"_DFN_"'"
12 ;
13 SET PTNAME=$P(^DPT(DFN,0),"^",1)
14 IF SEARCH="NAME",FILTER="" IF $P($G(DGRRCA),"^")=1 DO
15 .I $O(^DPT(DFN,.01,0)) D
16 .. SET (I,DONE)=0
17 .. SET ALIAS=""
18 .. FOR S I=$O(^DPT(DFN,.01,I)) Q:I<1 Q:DONE DO
19 ... SET ALIAS=$P($G(^DPT(DFN,.01,I,0)),"^",1)
20 ... IF ALIAS=$P(DGRRCA,"^",2) SET PTNAME="("_ALIAS_") "_PTNAME,DONE=1
21 .. IF DONE=0 SET PTNAME="(Unknown Alias) "_PTNAME
22 ;
23 ;IF SEARCH="NAME",FILTER="" IF $E(PTNAME,1,$L(VALUE))'=VALUE DO
24 ;. SET (I,DONE)=0
25 ;. SET ALIAS=""
26 ;. FOR S I=$O(^DPT(DFN,.01,I)) Q:I<1 Q:DONE DO
27 ;.. SET ALIAS=$P($G(^DPT(DFN,.01,I,0)),"^",1)
28 ;.. IF $E(ALIAS,1,$L(VALUE))=VALUE SET PTNAME="("_ALIAS_") "_PTNAME,DONE=1
29 ;. IF DONE=0 SET PTNAME="(Unknown Alias) "_PTNAME
30 ;
31 ; -- REQUIRED COMPONENTS
32 ;SENSITIV will be set to true to block the display of the SSN and DOB
33 ;if patient is marked as sensitive in DG Security Log (#38.1) file or
34 ;has an employee eligibility code
35 SET SENSITIV=$S($P($G(^DGSL(38.1,DFN,0)),"^",2)=1:"true",1:"false")
36 I SENSITIV="false" D
37 .S DGEMP=$$EMPL^DGSEC4(DFN)
38 .I DGEMP=1 S SENSITIV="true"
39 SET NAME=$$CHARCHK^DGRRUTL(PTNAME)
40 SET DOB=$$CHARCHK^DGRRUTL($P($G(^DPT(DFN,0)),"^",3))
41 SET SSN=$$CHARCHK^DGRRUTL($P($G(^DPT(DFN,0)),"^",9))
42 SET LINE=LINE_" sensitive='"_SENSITIV_"' name='"_NAME_"' dob='"_DOB_"' ssn='"_SSN_"' "
43 ;
44 ; -- OPTIONAL COMPONENTS
45 ;Patient Type (391)
46 SET TYPE=$$CHARCHK^DGRRUTL($P($G(^DG(391,+$G(^DPT(DFN,"TYPE")),0)),"^",1))
47 ;
48 ;gender
49 SET GENDER=$$CHARCHK^DGRRUTL($P($G(^DPT(DFN,0)),"^",2))
50 ;
51 ;icn
52 SET ICN=$$ICNLC^MPIF001(DFN)
53 ;
54 ;Primary Eligibility(.361)
55 SET PRIM=$$PRIM(DFN)
56 ;
57 SET SC=$P($G(^DPT(DFN,.3)),"^",1,2) ;Is Service Connected (.301) %=.302
58 SET SCPER=$P(SC,"^",2)
59 IF $P(SC,"^",1)="Y" SET SC="true"
60 IF $P(SC,"^",1)="N" SET SC="false"
61 ;
62 SET VET=$P($G(^DPT(DFN,"VET")),"^",1) ;Veteran Status (1901)
63 IF VET="Y" SET VET="true"
64 IF VET="N" SET VET="false"
65 ;
66 SET WARD=$$CHARCHK^DGRRUTL($E($G(^DPT(DFN,.1)),1,30))
67 SET ROOMBED=$$CHARCHK^DGRRUTL($P($G(^DPT(DFN,.101)),"^",1))
68 ;
69 ; get the PCP's IEN and convert to VPID (primary care physician) sgg 06/17/04
70 SET PATSPCP=$$NMPCPR^SCAPMCU2(DFN,DT,1)
71 SET PCPIEN=$P(PATSPCP,"^",1)
72 SET PCPNAME=$P(PATSPCP,"^",2)
73 SET PCPVPID=$$VPID^XUPS(+PCPIEN)
74 ;
75 SET LINE=LINE_" type='"_TYPE_"' primaryeligibility='"_PRIM_"' serviceconnected='"_SC_"' scpercent='"_SCPER_"'"
76 SET LINE=LINE_" gender='"_GENDER_"' icn='"_ICN_"' veteran='"_VET_"' ward='"_WARD_"' roombed='"_ROOMBED_"'"
77 SET LINE=LINE_" pcpien='"_PCPIEN_"' pcpvpid='"_PCPVPID_"' pcpname='"_PCPNAME_"'>"
78 I +$G(DGRRAPTS)=0 S LINE=LINE_"</patient>"
79 ;
80 DO ADD^DGRRUTL(LINE)
81 ;
82 DO NAMECOMP^DGRRLU0(DFN,DGRRPCNT)
83 ;
84 QUIT
85 ;
86MAXOUT ;
87 IF $G(MAXSIZRE)<1 DO ADD^DGRRUTL("<maximum message='Too many patients found (more than "_MAXSIZE_"). Please Limit Search.'></maximum>")
88 SET MAXSIZRE=1
89 QUIT
90 ;
91PRIM(DFN) ; -- returns print name from file 8.1
92 NEW PRIM1
93 SET PRIM1=$P($G(^DIC(8,+$G(^DPT(DFN,.36)),0)),"^",9) ; station entry
94 Q $$CHARCHK^DGRRUTL($P($G(^DIC(8.1,+PRIM1,0)),"^",6)) ; mas entry
Note: See TracBrowser for help on using the repository browser.