LA7VPID ;VA/DALOI/JMC - HL7 PID/PV1 segment builder utility ;JUL 06, 2010 3:14 PM
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997;Build 9
;
; Reference to routine $$EN^VAFHLPID supported by DBIA# 263
;
PID(LRDFN,LA7EXTID,LA7ARRAY,LA7PIDSN,HL,LA7ALTID) ; Build PID segment
; Call with LRDFN = Lab DFN, passed by value
; LA7EXTID = to return as external patient id, id used by non-VA systems (optional)
; LA7ARRAY = array to return PID array, pass by reference
; LA7PIDSN = PID id counter, passsed by value
; HL = HL7 variable array, pass by reference
; LA7ALTID = return alternate patient id, id used by non-va systems (optional)
;
; Returns LA7ARRAY
;
N DFN,HLQ,LA763,LA7Y,LRDPF,VAFPID
;
; Change HLQ - VAFHLPID puts delete indicator when Vista has no value for field - not according to standard.
S HLQ=""
;
I $G(LRDFN)=""!($G(HL("FS"))="") Q
I '$D(^LR(LRDFN,0)) Q
;
S LA7EXTID=$G(LA7EXTID),LA7ALTID=$G(LA7ALTID),LA7PIDSN=$G(LA7PIDSN)+1
S LA763(0)=$G(^LR(LRDFN,0))
S LRDPF=$P(LA763(0),"^",2),DFN=$P(LA763(0),"^",3)
;
; REFERRAL file (#67) with PATIENT file (#2) link, use info from PATIENT file.
I LRDPF=67,$P($G(^LRT(67,DFN,"DPT")),"^") D
.S LRDPF=2
. S DFN=$P($G(^LRT(67,DFN,"DPT")),"^")
;
; Patient file - use VAF call
I LRDPF=2 D F2PID
;
; Non-patient file
I LRDPF'=2 D NF2PID
K AGE,PNM,SEX,DOB,SSN,VA200,LRWRD,LRRB,LRTREA,VA
Q
;
;
PV1(LRDFN,LA7ARRAY,LA7FS,LA7ECH) ; Build PV1 segment
; Call with LRDFN = ien of entry in File #63
; LA7ARRAY = array to return PV1 array, pass by reference
; LA7FS = HL field separator
; LA7ECH = HL encoding characters
;
;
N DFN,LA763,LA7LOC,LRDPF,LA7Y
S LA763(0)=$G(^LR(LRDFN,0))
S LRDPF=$P(LA763(0),"^",2),DFN=$P(LA763(0),"^",3),LA7LOC=""
;
S LA7Y(0)="PV1"
S LA7Y(1)=1
;
; Referral file with Patient file link.
I LRDPF=67,$P($G(^LRT(67,DFN,"DPT")),"^") D
. S LRDPF=2
. S DFN=$P($G(^LRT(67,DFN,"DPT")),"^")
;
; Determine patient class
; Current inpatient location
I LRDPF=2 S LA7LOC=$G(^DPT(DFN,.1))
I $L(LA7LOC) S LA7Y(2)="I" ; Inpatient
;
; Otherwise from lab files
I $G(LA7LOC)="" D
. S LA7LOC=$G(^LR(LRDFN,.1))
. S LA7Y(2)="O" ; Default to outpatient
;
; Patient location
S LA7LOC=$$CHKDATA^LA7VHLU3(LA7LOC,LA7FS_LA7ECH)
S LA7Y(3)=LA7LOC
;
D BUILDSEG^LA7VHLU(.LA7Y,.LA7ARRAY,LA7FS)
Q
;
;
F2PID ; Build patient identifier field on file #2 patient
;
;
N I,ICN,LA7X,X
S LA7ARRAY(0)=$$EN^VAFHLPID(DFN,"1,5,6,7,8,10NTB,11,13,16,19",LA7PIDSN) ;ihs/cmi/maw 11/19/2010 added field 11 and 13
;
; Return external identifer in PID-2 sequence, backward compatibility to V2.2
I $L(LA7EXTID) D
. I '(LA7EXTID?1N.N) S $P(LA7ARRAY(0),HL("FS"),3)=LA7EXTID
. E S $P(LA7ARRAY(0),HLFS,3)=$$M11^HLFNC(LA7EXTID,HL("ECH"))
;
; Send SSN as patient identifier
S X=$$M11^HLFNC($P(LA7ARRAY(0),HLFS,20),HL("ECH"))
S $P(X,$E(HL("ECH")),5)="SS"
S $P(LA7ARRAY(0),HLFS,4)=X
;
; Send DFN as patient identifier
S X=$$M11^HLFNC(DFN,HL("ECH"))
S $P(X,$E(HL("ECH")),5)="PI"
S $P(X,$E(HL("ECH")),6)=$$GET1^DIQ(4,+$P($G(^XMB(1,1,"XUS")),"^",17),99)_$E(HL("ECH"),4)_$G(^XMB("NETNAME"))_$E(HL("ECH"),4)_"DNS"
S $P(LA7ARRAY(0),HLFS,4)=$P(LA7ARRAY(0),HL("FS"),4)_$E(HL("ECH"),2)_X
;
; Send ICN from MPI as patient identifier
S ICN=$$ICN(DFN,HL("ECH"))
I ICN>0 S $P(LA7ARRAY(0),HLFS,4)=$P(LA7ARRAY(0),HL("FS"),4)_$E(HL("ECH"),2)_ICN
;
; Send alternate patient id if passed
I LA7ALTID'="" S $P(LA7ARRAY(0),HL("FS"),5)=LA7ALTID
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"))
;
;cmi/maw 3/9/2010 pass HRN only across the interface
S $P(LA7ARRAY(0),HLFS,3)=$$HRN^AUPNPAT(DFN,DUZ(2))
S $P(LA7ARRAY(0),HLFS,4)=$$HRN^AUPNPAT(DFN,DUZ(2))
S $P(LA7ARRAY(0),HLFS,11)=""
S $P(LA7ARRAY(0),HLFS,13)=""
;cmi/maw 3/9/2010 end of mods
;cmi/maw 4/14/2010 mods for client number
S $P(LA7ARRAY(0),HLFS,19)=$$ACCT^LA7VQINS(LA7ORD) ;setup this function call
;cmi/maw 4/14/2010 end of mods for client number
;
; Check for overflow (>245)
I $O(VAFPID(0)) D
. S I=0
. F S I=$O(VAFPID(I)) Q:'I S LA7ARRAY(I)=VAFPID(I)
;
Q
;
;
NF2PID ; Build patient identifier field on non-file #2 patient
;
D PT^LRX
S LA7Y(0)="PID"
S LA7Y(1)=LA7PIDSN
;
; Return external identifer in PID-2 sequence, backward compatibility to V2.2
I LA7EXTID'="" D
. I '(LA7EXTID?1N.N) S LA7Y(2)=LA7EXTID
. E S LA7Y(2)=$$M11^HLFNC(LA7EXTID,HL("ECH"))
S LA7Y(3)=$$M11^HLFNC(SSN(2),HL("ECH"))
I LRDPF=67.1 S $P(LA7Y(3),$E(HL("ECH"),1),5)="L2"
;
; Send LRDFN as alternate patient ID, unless alternate id passed
I LA7ALTID'="" S LA7Y(4)=LA7ALTID
E S LA7Y(4)=LRDFN
I LA7Y(4)?1N.N S LA7Y(4)=$$M11^HLFNC(LA7Y(4),HL("ECH"))
;
S LA7Y(5)=$$HLNAME^HLFNC($G(PNM),HL("ECH"))
;
I $G(DOB)'="" D
. S DOB=$$CHKDT^LA7VHLU1(DOB)
. S LA7Y(7)=$$FMTHL7^XLFDT(DOB)
;
S LA7Y(8)=$S($G(SEX)'="":SEX,1:"U")
;
; Race - if from REFERRAL PATIENT file (#67) then check RACE field.
S LA7Y(10)=""
I LRDPF=67 D
. S LA7X=$$GET1^DIQ(67,DFN_",",.06,"I")
. I LA7X<1 Q
. S LA7Y(10)=$$PTR2CODE^DGUTL4(LA7X,1,2)
. S $P(LA7Y(10),$E(HL("ECH"),1),2)=$$PTR2TEXT^DGUTL4(LA7X,1)
. S $P(LA7Y(10),$E(HL("ECH"),1),3)="HL70005"
;
; SSN from referral file if 9N - DoD uses PID-19 to validate
S LA7Y(19)=""
I LRDPF=67 D
. S LA7X=$$GET1^DIQ(67,DFN_",",.09,"I")
. I LA7X?9N S LA7Y(19)=LA7X
;
D BUILDSEG^LA7VHLU(.LA7Y,.LA7ARRAY,HL("FS"))
Q
;
;
ICN(DFN,LA7ECH) ; Send ICN from MPI
; Call with DFN = internal entry number of patient in PATIENT #2 file.
; LA7ECH = HL7 encoding characters.
;
N ICN,LA7ICN
;
S ICN=""
;
S X="MPIF001" X ^%ZOSF("TEST")
I $T D
. S LA7ICN=$$GETICN^MPIF001(DFN)
. I LA7ICN<1 Q
. S ICN=LA7ICN
. S $P(ICN,$E(LA7ECH,1),4)="USVHA"_$E(LA7ECH,4)_$E(LA7ECH,4)_"HL70363"
. S $P(ICN,$E(LA7ECH,1),5)="NI"
. S $P(ICN,$E(LA7ECH,1),6)="VA FACILITY ID"_$E(LA7ECH,4)_$P($$SITE^VASITE,"^",3)_$E(LA7ECH,4)_"L"
;
Q ICN
LA7VPID ;VA/DALOI/JMC - HL7 PID/PV1 segment builder utility ;JUL 06, 2010 3:14 PM
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997;Build 9
+2 ;
+3 ; Reference to routine $$EN^VAFHLPID supported by DBIA# 263
+4 ;
PID(LRDFN,LA7EXTID,LA7ARRAY,LA7PIDSN,HL,LA7ALTID) ; Build PID segment
+1 ; Call with LRDFN = Lab DFN, passed by value
+2 ; LA7EXTID = to return as external patient id, id used by non-VA systems (optional)
+3 ; LA7ARRAY = array to return PID array, pass by reference
+4 ; LA7PIDSN = PID id counter, passsed by value
+5 ; HL = HL7 variable array, pass by reference
+6 ; LA7ALTID = return alternate patient id, id used by non-va systems (optional)
+7 ;
+8 ; Returns LA7ARRAY
+9 ;
+10 NEW DFN,HLQ,LA763,LA7Y,LRDPF,VAFPID
+11 ;
+12 ; Change HLQ - VAFHLPID puts delete indicator when Vista has no value for field - not according to standard.
+13 SET HLQ=""
+14 ;
+15 IF $GET(LRDFN)=""!($GET(HL("FS"))="")
QUIT
+16 IF '$DATA(^LR(LRDFN,0))
QUIT
+17 ;
+18 SET LA7EXTID=$GET(LA7EXTID)
SET LA7ALTID=$GET(LA7ALTID)
SET LA7PIDSN=$GET(LA7PIDSN)+1
+19 SET LA763(0)=$GET(^LR(LRDFN,0))
+20 SET LRDPF=$PIECE(LA763(0),"^",2)
SET DFN=$PIECE(LA763(0),"^",3)
+21 ;
+22 ; REFERRAL file (#67) with PATIENT file (#2) link, use info from PATIENT file.
+23 IF LRDPF=67
IF $PIECE($GET(^LRT(67,DFN,"DPT")),"^")
Begin DoDot:1
+24 SET LRDPF=2
+25 SET DFN=$PIECE($GET(^LRT(67,DFN,"DPT")),"^")
End DoDot:1
+26 ;
+27 ; Patient file - use VAF call
+28 IF LRDPF=2
DO F2PID
+29 ;
+30 ; Non-patient file
+31 IF LRDPF'=2
DO NF2PID
+32 KILL AGE,PNM,SEX,DOB,SSN,VA200,LRWRD,LRRB,LRTREA,VA
+33 QUIT
+34 ;
+35 ;
PV1(LRDFN,LA7ARRAY,LA7FS,LA7ECH) ; Build PV1 segment
+1 ; Call with LRDFN = ien of entry in File #63
+2 ; LA7ARRAY = array to return PV1 array, pass by reference
+3 ; LA7FS = HL field separator
+4 ; LA7ECH = HL encoding characters
+5 ;
+6 ;
+7 NEW DFN,LA763,LA7LOC,LRDPF,LA7Y
+8 SET LA763(0)=$GET(^LR(LRDFN,0))
+9 SET LRDPF=$PIECE(LA763(0),"^",2)
SET DFN=$PIECE(LA763(0),"^",3)
SET LA7LOC=""
+10 ;
+11 SET LA7Y(0)="PV1"
+12 SET LA7Y(1)=1
+13 ;
+14 ; Referral file with Patient file link.
+15 IF LRDPF=67
IF $PIECE($GET(^LRT(67,DFN,"DPT")),"^")
Begin DoDot:1
+16 SET LRDPF=2
+17 SET DFN=$PIECE($GET(^LRT(67,DFN,"DPT")),"^")
End DoDot:1
+18 ;
+19 ; Determine patient class
+20 ; Current inpatient location
+21 IF LRDPF=2
SET LA7LOC=$GET(^DPT(DFN,.1))
+22 ; Inpatient
IF $LENGTH(LA7LOC)
SET LA7Y(2)="I"
+23 ;
+24 ; Otherwise from lab files
+25 IF $GET(LA7LOC)=""
Begin DoDot:1
+26 SET LA7LOC=$GET(^LR(LRDFN,.1))
+27 ; Default to outpatient
SET LA7Y(2)="O"
End DoDot:1
+28 ;
+29 ; Patient location
+30 SET LA7LOC=$$CHKDATA^LA7VHLU3(LA7LOC,LA7FS_LA7ECH)
+31 SET LA7Y(3)=LA7LOC
+32 ;
+33 DO BUILDSEG^LA7VHLU(.LA7Y,.LA7ARRAY,LA7FS)
+34 QUIT
+35 ;
+36 ;
F2PID ; Build patient identifier field on file #2 patient
+1 ;
+2 ;
+3 NEW I,ICN,LA7X,X
+4 ;ihs/cmi/maw 11/19/2010 added field 11 and 13
SET LA7ARRAY(0)=$$EN^VAFHLPID(DFN,"1,5,6,7,8,10NTB,11,13,16,19",LA7PIDSN)
+5 ;
+6 ; Return external identifer in PID-2 sequence, backward compatibility to V2.2
+7 IF $LENGTH(LA7EXTID)
Begin DoDot:1
+8 IF '(LA7EXTID?1N.N)
SET $PIECE(LA7ARRAY(0),HL("FS"),3)=LA7EXTID
+9 IF '$TEST
SET $PIECE(LA7ARRAY(0),HLFS,3)=$$M11^HLFNC(LA7EXTID,HL("ECH"))
End DoDot:1
+10 ;
+11 ; Send SSN as patient identifier
+12 SET X=$$M11^HLFNC($PIECE(LA7ARRAY(0),HLFS,20),HL("ECH"))
+13 SET $PIECE(X,$EXTRACT(HL("ECH")),5)="SS"
+14 SET $PIECE(LA7ARRAY(0),HLFS,4)=X
+15 ;
+16 ; Send DFN as patient identifier
+17 SET X=$$M11^HLFNC(DFN,HL("ECH"))
+18 SET $PIECE(X,$EXTRACT(HL("ECH")),5)="PI"
+19 SET $PIECE(X,$EXTRACT(HL("ECH")),6)=$$GET1^DIQ(4,+$PIECE($GET(^XMB(1,1,"XUS")),"^",17),99)_$EXTRACT(HL("ECH"),4)_$GET(^XMB("NETNAME"))_$EXTRACT(HL("ECH"),4)_"DNS"
+20 SET $PIECE(LA7ARRAY(0),HLFS,4)=$PIECE(LA7ARRAY(0),HL("FS"),4)_$EXTRACT(HL("ECH"),2)_X
+21 ;
+22 ; Send ICN from MPI as patient identifier
+23 SET ICN=$$ICN(DFN,HL("ECH"))
+24 IF ICN>0
SET $PIECE(LA7ARRAY(0),HLFS,4)=$PIECE(LA7ARRAY(0),HL("FS"),4)_$EXTRACT(HL("ECH"),2)_ICN
+25 ;
+26 ; Send alternate patient id if passed
+27 IF LA7ALTID'=""
SET $PIECE(LA7ARRAY(0),HL("FS"),5)=LA7ALTID
+28 IF $PIECE(LA7ARRAY(0),HLFS,5)?1N.N
SET $PIECE(LA7ARRAY(0),HL("FS"),5)=$$M11^HLFNC($PIECE(LA7ARRAY(0),HL("FS"),5),HL("ECH"))
+29 ;
+30 ;cmi/maw 3/9/2010 pass HRN only across the interface
+31 SET $PIECE(LA7ARRAY(0),HLFS,3)=$$HRN^AUPNPAT(DFN,DUZ(2))
+32 SET $PIECE(LA7ARRAY(0),HLFS,4)=$$HRN^AUPNPAT(DFN,DUZ(2))
+33 SET $PIECE(LA7ARRAY(0),HLFS,11)=""
+34 SET $PIECE(LA7ARRAY(0),HLFS,13)=""
+35 ;cmi/maw 3/9/2010 end of mods
+36 ;cmi/maw 4/14/2010 mods for client number
+37 ;setup this function call
SET $PIECE(LA7ARRAY(0),HLFS,19)=$$ACCT^LA7VQINS(LA7ORD)
+38 ;cmi/maw 4/14/2010 end of mods for client number
+39 ;
+40 ; Check for overflow (>245)
+41 IF $ORDER(VAFPID(0))
Begin DoDot:1
+42 SET I=0
+43 FOR
SET I=$ORDER(VAFPID(I))
IF 'I
QUIT
SET LA7ARRAY(I)=VAFPID(I)
End DoDot:1
+44 ;
+45 QUIT
+46 ;
+47 ;
NF2PID ; Build patient identifier field on non-file #2 patient
+1 ;
+2 DO PT^LRX
+3 SET LA7Y(0)="PID"
+4 SET LA7Y(1)=LA7PIDSN
+5 ;
+6 ; Return external identifer in PID-2 sequence, backward compatibility to V2.2
+7 IF LA7EXTID'=""
Begin DoDot:1
+8 IF '(LA7EXTID?1N.N)
SET LA7Y(2)=LA7EXTID
+9 IF '$TEST
SET LA7Y(2)=$$M11^HLFNC(LA7EXTID,HL("ECH"))
End DoDot:1
+10 SET LA7Y(3)=$$M11^HLFNC(SSN(2),HL("ECH"))
+11 IF LRDPF=67.1
SET $PIECE(LA7Y(3),$EXTRACT(HL("ECH"),1),5)="L2"
+12 ;
+13 ; Send LRDFN as alternate patient ID, unless alternate id passed
+14 IF LA7ALTID'=""
SET LA7Y(4)=LA7ALTID
+15 IF '$TEST
SET LA7Y(4)=LRDFN
+16 IF LA7Y(4)?1N.N
SET LA7Y(4)=$$M11^HLFNC(LA7Y(4),HL("ECH"))
+17 ;
+18 SET LA7Y(5)=$$HLNAME^HLFNC($GET(PNM),HL("ECH"))
+19 ;
+20 IF $GET(DOB)'=""
Begin DoDot:1
+21 SET DOB=$$CHKDT^LA7VHLU1(DOB)
+22 SET LA7Y(7)=$$FMTHL7^XLFDT(DOB)
End DoDot:1
+23 ;
+24 SET LA7Y(8)=$SELECT($GET(SEX)'="":SEX,1:"U")
+25 ;
+26 ; Race - if from REFERRAL PATIENT file (#67) then check RACE field.
+27 SET LA7Y(10)=""
+28 IF LRDPF=67
Begin DoDot:1
+29 SET LA7X=$$GET1^DIQ(67,DFN_",",.06,"I")
+30 IF LA7X<1
QUIT
+31 SET LA7Y(10)=$$PTR2CODE^DGUTL4(LA7X,1,2)
+32 SET $PIECE(LA7Y(10),$EXTRACT(HL("ECH"),1),2)=$$PTR2TEXT^DGUTL4(LA7X,1)
+33 SET $PIECE(LA7Y(10),$EXTRACT(HL("ECH"),1),3)="HL70005"
End DoDot:1
+34 ;
+35 ; SSN from referral file if 9N - DoD uses PID-19 to validate
+36 SET LA7Y(19)=""
+37 IF LRDPF=67
Begin DoDot:1
+38 SET LA7X=$$GET1^DIQ(67,DFN_",",.09,"I")
+39 IF LA7X?9N
SET LA7Y(19)=LA7X
End DoDot:1
+40 ;
+41 DO BUILDSEG^LA7VHLU(.LA7Y,.LA7ARRAY,HL("FS"))
+42 QUIT
+43 ;
+44 ;
ICN(DFN,LA7ECH) ; Send ICN from MPI
+1 ; Call with DFN = internal entry number of patient in PATIENT #2 file.
+2 ; LA7ECH = HL7 encoding characters.
+3 ;
+4 NEW ICN,LA7ICN
+5 ;
+6 SET ICN=""
+7 ;
+8 SET X="MPIF001"
XECUTE ^%ZOSF("TEST")
+9 IF $TEST
Begin DoDot:1
+10 SET LA7ICN=$$GETICN^MPIF001(DFN)
+11 IF LA7ICN<1
QUIT
+12 SET ICN=LA7ICN
+13 SET $PIECE(ICN,$EXTRACT(LA7ECH,1),4)="USVHA"_$EXTRACT(LA7ECH,4)_$EXTRACT(LA7ECH,4)_"HL70363"
+14 SET $PIECE(ICN,$EXTRACT(LA7ECH,1),5)="NI"
+15 SET $PIECE(ICN,$EXTRACT(LA7ECH,1),6)="VA FACILITY ID"_$EXTRACT(LA7ECH,4)_$PIECE($$SITE^VASITE,"^",3)_$EXTRACT(LA7ECH,4)_"L"
End DoDot:1
+16 ;
+17 QUIT ICN
