| 1 | DGLBPID ;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 | ;
|
|---|
| 22 | ID(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 | ;
|
|---|
| 34 | HRN(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 | ;
|
|---|
| 39 | GOTIDQ(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 | ;
|
|---|
| 46 | REQID(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 | ;
|
|---|
| 55 | IDCAP() ;Returns 3 characters: " ID" or "SSN"
|
|---|
| 56 | I $G(DUZ("AG"))="E" Q " ID"
|
|---|
| 57 | Q "SSN"
|
|---|
| 58 | ;
|
|---|
| 59 | ;
|
|---|
| 60 | ;
|
|---|
| 61 | ;
|
|---|
| 62 | ;
|
|---|
| 63 | ;
|
|---|
| 64 | LONGID ;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 | ;
|
|---|
| 71 | SHORTID ;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 | ;
|
|---|
| 78 | IHSID ;
|
|---|
| 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
|
|---|
| 90 | DFNID 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
|
|---|
| 101 | SSNID ;
|
|---|
| 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
|
|---|
| 107 | GETALL ;
|
|---|
| 108 | ;Utility Subroutine to Getall the variables
|
|---|
| 109 | D DFNID,IHSID,SSNID
|
|---|
| 110 | ;K DFNID,SSNID ; kill because HRN is "required"
|
|---|
| 111 | Q
|
|---|
| 112 | ;
|
|---|
| 113 | ENALL ;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
|
|---|
