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

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

revised back to 6/30/08 version

File size: 4.3 KB
Line 
1DGLBPID ;DJW,TOAD; Health Record Number Identifier ;5/1/07 20:26
2 ;;5.3;Registration;**634**;Aug 13, 1993;Build 28
3 ; Copyright (C) 2007 WorldVistA
4 ;
5 ; This program is free software; you can redistribute it and/or modify
6 ; it under the terms of the GNU General Public License as published by
7 ; the Free Software Foundation; either version 2 of the License, or
8 ; (at your option) any later version.
9 ;
10 ; This program is distributed in the hope that it will be useful,
11 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ; GNU General Public License for more details.
14 ;
15 ; You should have received a copy of the GNU General Public License
16 ; along with this program; if not, write to the Free Software
17 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
18 ;'Modified' MAS Patient Look-up Check Cross-References June 1987
19 Q
20 ;
21 ;
22ID(DFN) ;GFT/VW IA 10035
23 N ID S ID=$P($G(^DPT(DFN,.36)),U,3) ;PRIMARY LONG ID
24 I ID="" S ID=$$HRN(DFN)
25 I ID="" S ID=$P($G(^DPT(DFN,0)),U,9) I ID]"" S ID=$E(ID,1,3)_"-"_$E(ID,4,5)_"-"_$E(ID,6,99)
26 I ID="" D
27 .N I F I=0:0 S I=$O(^AUPNPAT(DFN,41,I)) Q:'I I $P($G(^(I,0)),U,5)="" S ID=$P($G(^(0)),U,2) I ID]"" S ID=ID_" ("_$P($G(^DIC(4,I,0)),U,5)_")" Q
28 I ID="" S ID="`"_DFN
29 Q ID
30 ;
31 ;
32 ;
33 ;
34HRN(DFN) ;LOOKUP HEALTH RECORD NUMBER
35 I '$G(DUZ(2)) Q ""
36 Q $P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)
37 ;
38 ;
39GOTIDQ(DFN) ;Do we have the needed number for this guy?
40 N T S T=$$REQID(DFN)
41 I T="SSN" Q $P(^DPT(DFN,0),U,9)]""
42 I T="HRN" Q:'$G(DUZ(2)) 0 Q $P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)]""
43 Q 1
44 ;
45 ;
46REQID(DFN) ;WHICH IDENTIFICATION FORMAT IS REQUIRED?
47 N TYPE S TYPE=""
48 D:$G(DFN)
49 .S TYPE=+$G(^DPT(DFN,.361)) I TYPE S TYPE=$P($G(^DIC(8,TYPE,0)),U,9) ;try PRIMARY ELIGIBILITY CODE
50 .I TYPE="" S TYPE=+$G(^DPT(DFN,"TYPE")) I TYPE S TYPE=+$G(^DG(391,TYPE,8.2)) ;try patient TYPE
51 I 'TYPE S TYPE=$G(DUZ("AG")),TYPE=$S(TYPE="V":1,1:2) ;or just assume it's HRN if not VA
52 Q $P("SSN^HRN",U,TYPE)
53 ;
54 ;
55IDCAP() ;Returns 3 characters: " ID" or "SSN"
56 I $G(DUZ("AG"))="E" Q " ID"
57 Q "SSN"
58 ;
59 ;
60 ;
61 ;
62 ;
63 ;
64LONGID ;Called by ^DIC(8.2,2,"LONG") (assumes DA(1) is DFN!)
65 N INSTITU,DFN,DFNID,SSNID,IHSID D GETALL
66 S X=$S($G(IHSID("L"))'?."-":IHSID("L"),$G(SSNID("L"))'?."-":SSNID("L"),$G(DFNID("L"))'?."-":DFNID("L"),1:"")
67 ;I X="" W 1/0 ;some LONGID must exist for a patient, else ERROR!
68 Q
69 ;
70 ;
71SHORTID ;Called by ^DIC(8.2,2,"SHORT") (assumes DA(1) is DFN!)
72 N INSTITU,DFN,DFNID,SSNID,IHSID D GETALL
73 S X=$S($G(IHSID("S"))'?."-":IHSID("S"),$G(SSNID("S"))'?."-":SSNID("S"),$G(DFNID("S"))'?."-":DFNID("S"),1:"")
74 ;I X="" W 1/0 ;some SHORTID must exist for a patient, else ERROR!
75 Q
76 ;
77 ;
78IHSID ;
79 ;given INSTITU (current institution #)
80 ;get HEALTH RECORD NUMBER (Multiple 4101, 9000001.41) associated
81 ;with the institution
82 S IHSID=$P($G(^AUPNPAT(DFN,41,+INSTITU,0)),"^",2)
83 I IHSID'="" D
84 . S IHSID("L")=IHSID ; $J(IHSID,12) ; if we want to zero pad then $TR($J(IHSID("L"),12)," ",0)
85 . S IHSID("S")=$TR(IHSID("L"),$TR(IHSID("L"),9876543210))
86 . S IHSID("S")=$TR($J(IHSID("S"),4)," ",0)
87 . S IHSID("S")=$E(IHSID("S"),$L(IHSID("S"))-3,$L(IHSID("S")))
88 ;now return Health Record Number
89 Q
90DFNID S DFN=DA(1) ; IEN in patient file, with default institution from
91 ;kernel system parameters file as prefix.
92 ;8989.3,217 DEFAULT INSTITUTION of #8989.3 -- KERNEL SYSTEM PARAMETERS FILE
93 S INSTITU=$P($G(^XTV(8989.3,1,"XUS")),U,17)
94 ;150.9 VISIT TRACKING PARAMETERS :: DEFAULT INSTITUTION:
95 I INSTITU="",$P($G(^DIC(150.9,1,0)),U,4)'="" S INSTITU=$P(^(0),U,4)
96 ; if we have a medical record number in IHS PATIENT, for this
97 I INSTITU'="",$P($G(^DIC(4,+INSTITU,99)),U)'="" S INSTITU("STA#")=$P(^(99),U)
98 ; now put INSTITUtion STATION NUMBER as prefix to DFN as "DFNID"
99 S DFNID("S")="`"_DFN,DFNID("L")=999_"-`"_DFN S:$D(INSTITU("STA#"))#2 DFNID("L")=INSTITU("STA#")_"-`"_DFN
100 Q
101SSNID ;
102 ;code scarfed from ^DIC(8.2,1,"LONG") - retrieving the SSN
103 N X
104 S SSNID("L")="" I $D(DFN),$D(^DPT(DFN,0)) S X=$P(^(0),U,9),SSNID("L")=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
105 S SSNID("S")=$P(SSNID("L"),"-",3)
106 Q
107GETALL ;
108 ;Utility Subroutine to Getall the variables
109 D DFNID,IHSID,SSNID
110 ;K DFNID,SSNID ; kill because HRN is "required"
111 Q
112 ;
113ENALL ;RE-INDEX PHONE NUMBER (KIDS POST-INSTALL DG*5.3*634)
114 K ^DPT("AZVWVOE")
115 N DIK S DIK="^DPT(",DIK(1)=".131^251000" D ENALL^DIK
116 Q
Note: See TracBrowser for help on using the repository browser.