Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7VPID

LA7VPID.m

Go to the documentation of this file. 
  1. LA7VPID ;DALOI/JMC - HL7 PID/PV1 segment builder utility ;08/03/09  15:59
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,74**;Sep 27, 1994;Build 229
  1.  ;
  1.  ; Reference to routine $$EN^VAFHLPID supported by DBIA# 263
  1.  ;
  1. PID(LRDFN,LA7EXTID,LA7ARRAY,LA7PIDSN,HL,LA7ALTID) ; Build PID segment
  1.  ; Call with     LRDFN = Lab DFN, passed by value
  1.  ;            LA7EXTID = to return as external patient id, id used by non-VA systems (optional)
  1.  ;            LA7ARRAY = array to return PID array, pass by reference
  1.  ;            LA7PIDSN = PID id counter, passed by value
  1.  ;                  HL = HL7 variable array, pass by reference
  1.  ;            LA7ALTID = return alternate patient id, id used by non-va systems (optional)
  1.  ;
  1.  ; Returns LA7ARRAY
  1.  ;
  1.  N DFN,HLQ,LA763,LA7Y,LRDPF,VAFPID
  1.  ;
  1.  ; Change HLQ - VAFHLPID puts delete indicator when Vista has no value for field - not according to standard.
  1.  S HLQ=""
  1.  ;
  1.  I $G(LRDFN)=""!($G(HL("FS"))="") Q
  1.  I '$D(^LR(LRDFN,0)) Q
  1.  ;
  1.  S LA7EXTID=$G(LA7EXTID),LA7ALTID=$G(LA7ALTID),LA7PIDSN=$G(LA7PIDSN)+1
  1.  S LA763(0)=$G(^LR(LRDFN,0))
  1.  S LRDPF=$P(LA763(0),"^",2),DFN=$P(LA763(0),"^",3)
  1.  ;
  1.  ; Patient file - use VAF call
  1.  I LRDPF=2 D F2PID
  1.  ;
  1.  ; Non-patient file
  1.  I LRDPF'=2 D NF2PID
  1.  K AGE,PNM,SEX,DOB,SSN,VA200,LRWRD,LRRB,LRTREA,VA
  1.  Q
  1.  ;
  1.  ;
  1. PV1(LRDFN,LA7ARRAY,LA7FS,LA7ECH) ; Build PV1 segment
  1.  ; Call with    LRDFN = ien of entry in File #63
  1.  ;           LA7ARRAY = array to return PV1 array, pass by reference
  1.  ;              LA7FS = HL field separator
  1.  ;             LA7ECH = HL encoding characters
  1.  ;
  1.  ;
  1.  N DFN,LA763,LA7LOC,LRDPF,LA7Y
  1.  S LA763(0)=$G(^LR(LRDFN,0))
  1.  S LRDPF=$P(LA763(0),"^",2),DFN=$P(LA763(0),"^",3),LA7LOC=""
  1.  ;
  1.  S LA7Y(0)="PV1"
  1.  S LA7Y(1)=1
  1.  ;
  1.  ; Referral file with Patient file link.
  1.  I LRDPF=67,$P($G(^LRT(67,DFN,"DPT")),"^") D
  1.  . S LRDPF=2
  1.  . S DFN=$P($G(^LRT(67,DFN,"DPT")),"^")
  1.  ;
  1.  ; Determine patient class
  1.  ; Current inpatient location
  1.  I LRDPF=2 S LA7LOC=$G(^DPT(DFN,.1))
  1.  I $L(LA7LOC) S LA7Y(2)="I" ; Inpatient
  1.  ;
  1.  ; Otherwise from lab files
  1.  I $G(LA7LOC)="" D
  1.  . S LA7LOC=$G(^LR(LRDFN,.1))
  1.  . S LA7Y(2)="O" ; Default to outpatient
  1.  ;
  1.  ; Patient location
  1.  S LA7LOC=$$CHKDATA^LA7VHLU3(LA7LOC,LA7FS_LA7ECH)
  1.  S LA7Y(3)=LA7LOC
  1.  ;
  1.  D BUILDSEG^LA7VHLU(.LA7Y,.LA7ARRAY,LA7FS)
  1.  Q
  1.  ;
  1.  ;
  1. F2PID ; Build patient identifier field on file #2 patient
  1.  ;
  1.  ; Non VA users of VistA need to send patient's address
  1.  N I,ICN,LA7X,LRSTR,X
  1.  S LA7STR="1,5,6,7,8,10NTB,"_$S(DUZ("AG")="V":"",1:"11,")_"16,19"
  1.  S LA7ARRAY(0)=$$EN^VAFHLPID(DFN,LA7STR,LA7PIDSN,3)
  1.  ;
  1.  ; Check for overflow (>245)
  1.  I $O(VAFPID(0)) D
  1.  . S I=0
  1.  . F  S I=$O(VAFPID(I)) Q:'I  S LA7ARRAY(I)=VAFPID(I)
  1.  ;
  1.  ; Return external identifier in PID-2 sequence, backward compatibility to V2.2
  1.  I LA7EXTID'="" D
  1.  . I '(LA7EXTID?1N.N) S $P(LA7ARRAY(0),HL("FS"),3)=LA7EXTID
  1.  . E  S $P(LA7ARRAY(0),HLFS,3)=$$M11^HLFNC(LA7EXTID,HL("ECH"))
  1.  ;
  1.  ; Send SSN as patient identifier
  1.  S X=$P(LA7ARRAY(0),HLFS,4)
  1.  I $P(X,$E(HL("ECH")),5)="SS" S $P(X,$E(HL("ECH")),1)=$TR($P(X,$E(HL("ECH")),1),"-",""),$P(LA7ARRAY(0),HLFS,4)=X
  1.  ;
  1.  ; Send DFN as patient identifier
  1.  S X=$$M11^HLFNC(DFN,HL("ECH"))
  1.  S $P(X,$E(HL("ECH")),5)="PI"
  1.  S $P(X,$E(HL("ECH")),6)=$$RETFACID^LA7VHLU2(+$$KSP^XUPARAM("INST"),2,1)_$E(HL("ECH"),4)_$$KSP^XUPARAM("WHERE")_$E(HL("ECH"),4)_"DNS"
  1.  S $P(LA7ARRAY(0),HLFS,4)=$P(LA7ARRAY(0),HL("FS"),4)_$E(HL("ECH"),2)_X
  1.  ;
  1.  ; Send ICN from MPI as patient identifier
  1.  S ICN=$$ICN(DFN,HL("ECH"))
  1.  I ICN>0 S $P(LA7ARRAY(0),HLFS,4)=$P(LA7ARRAY(0),HL("FS"),4)_$E(HL("ECH"),2)_ICN
  1.  ;
  1.  ; Send alternate patient id if passed
  1.  I LA7ALTID'="" S $P(LA7ARRAY(0),HL("FS"),5)=LA7ALTID
  1.  I $P(LA7ARRAY(0),HLFS,5)?1N.N S $P(LA7ARRAY(0),HL("FS"),5)=$$M11^HLFNC($P(LA7ARRAY(0),HL("FS"),5),HL("ECH"))
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. NF2PID ; Build patient identifier field on non-file #2 patient
  1.  ;
  1.  N X
  1.  D PT^LRX
  1.  S LA7Y(0)="PID"
  1.  S LA7Y(1)=LA7PIDSN
  1.  ;
  1.  ; Return external identifier in PID-2 sequence, backward compatibility to V2.2
  1.  ; Also include external identifier in PID-3 for current versions (>v2.2)
  1.  S LA7Y(3)=""
  1.  I LA7EXTID'="" D
  1.  . I '(LA7EXTID?1N.N) S LA7Y(2)=LA7EXTID
  1.  . E  S LA7Y(2)=$$M11^HLFNC(LA7EXTID,HL("ECH"))
  1.  . S LA7Y(3)=LA7EXTID
  1.  ;
  1.  S X=$$M11^HLFNC(SSN(2),HL("ECH"))
  1.  I LRDPF=67.1 S $P(X,$E(HL("ECH"),1),5)="L2"
  1.  I LA7Y(3)'="",LA7Y(3)'[SSN(2) S LA7Y(3)=LA7Y(3)_$E(HL("ECH"),2)_X
  1.  I LA7Y(3)="" S LA7Y(3)=X
  1.  ;
  1.  ; Send LRDFN as alternate patient ID, unless alternate id passed
  1.  I LA7ALTID'="" S LA7Y(4)=LA7ALTID
  1.  E  S LA7Y(4)=LRDFN
  1.  I LA7Y(4)?1N.N S LA7Y(4)=$$M11^HLFNC(LA7Y(4),HL("ECH"))
  1.  I $P(LA7Y(4),$E(HL("ECH"),1),5)="" S $P(LA7Y(4),$E(HL("ECH"),1),5)="U"
  1.  ;
  1.  S LA7Y(5)=$$HLNAME^XLFNAME(PNM,"S",$E(HL("ECH")))
  1.  ;
  1.  I $G(DOB)'="" D
  1.  . S DOB=$$CHKDT^LA7VHLU1(DOB)
  1.  . S LA7Y(7)=$$FMTHL7^XLFDT(DOB)
  1.  ;
  1.  S LA7Y(8)=$S($G(SEX)'="":SEX,1:"U")
  1.  ;
  1.  ; Race - if from REFERRAL PATIENT file (#67) then check RACE field.
  1.  S LA7Y(10)=""
  1.  I LRDPF=67 D
  1.  . S LA7X=$$GET1^DIQ(67,DFN_",",.06,"I")
  1.  . I LA7X<1 Q
  1.  . S LA7Y(10)=$$PTR2CODE^DGUTL4(LA7X,1,2)
  1.  . S $P(LA7Y(10),$E(HL("ECH"),1),2)=$$PTR2TEXT^DGUTL4(LA7X,1)
  1.  . S $P(LA7Y(10),$E(HL("ECH"),1),3)="HL70005"
  1.  ;
  1.  ; SSN from referral file if 9N - DoD uses PID-19 to validate
  1.  S LA7Y(19)=""
  1.  I LRDPF=67 D
  1.  . S LA7X=$$GET1^DIQ(67,DFN_",",.09,"I")
  1.  . I LA7X?9N S LA7Y(19)=LA7X
  1.  ;
  1.  D BUILDSEG^LA7VHLU(.LA7Y,.LA7ARRAY,HL("FS"))
  1.  Q
  1.  ;
  1.  ;
  1. ICN(DFN,LA7ECH) ; Send ICN from MPI
  1.  ; Call with DFN = internal entry number of patient in PATIENT #2 file.
  1.  ;        LA7ECH = HL7 encoding characters.
  1.  ;
  1.  ; If ICN is local then assigning facility is local site
  1.  ;    otherwise indicate 200M.
  1.  ;
  1.  N ICN,LA7ICN,LOCAL,SITE
  1.  ;
  1.  S ICN=""
  1.  ;
  1.  S LA7ICN=$$GETICN^MPIF001(DFN)
  1.  I LA7ICN>0 D
  1.  . S ICN=LA7ICN
  1.  . S LOCAL=$$IFLOCAL^MPIF001(DFN)
  1.  . I LOCAL'=1 S SITE="200M"
  1.  . E  S SITE=$P($$SITE^VASITE,"^",3)
  1.  . S $P(ICN,$E(LA7ECH,1),4)="USVHA"_$E(LA7ECH,4)_$E(LA7ECH,4)_"HL70363"
  1.  . S $P(ICN,$E(LA7ECH,1),5)="NI"
  1.  . S $P(ICN,$E(LA7ECH,1),6)="VA FACILITY ID"_$E(LA7ECH,4)_SITE_$E(LA7ECH,4)_"L"
  1.  ;
  1.  Q ICN