×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Tcl to Map NK1.3 based on table only mapping first NK1 not conescutive

Tcl to Map NK1.3 based on table only mapping first NK1 not conescutive

Tcl to Map NK1.3 based on table only mapping first NK1 not conescutive

(OP)
I have a Tcl script that maps a contacts relationship in the NK1.3 field based on a table. There can sometimes be multipl NK1 segments but my script is only mapping the first NK1.3 not the consecutive ones listed.

The script does a bunch of other stuff as well, I'm not sure how to get it to map the other NK1 segments as well.
Example Message:
MSH|^~\&||ZZZ|||202106301008||ADT^A05|EFORM-ADT.1.16343|D|2.4|||AL|NE|
EVN||202106301008|||HHAPPY^HAPPY^HAPPY^^^^^^^^^XX|202106301030|
PID|1||M0009999^^^^MR~999-99-9999^^^^SS~M9999^^^^PI||TEST^CPSINTERFACE^1^^^^L~TESTING^CPS^INT^^^^M|TESTER,MOM|19820504|M||U|123 SILLY STREET^^NOTOWN^WA^99999^^^^ZZ||(999)999-9999^PRN|(999)999-9999^WPN||S|NA|G000099999|
ROL|1|AD|FHCP|ZZZZZ^ZUPER^ZUPER^S^^ARNP^^^^^^^XX|
ROL|2|AD|PP|ZZZZ^ZUPER^ZUPER^S^^ARNP^^^^^^^XX|
NK1|1|TESTER^GRANDMOTHER|GM|825 SILLY STREET^^NOTOWN^WA^99999|(999)999-9999||NOK|
NK1|2|TESTER^MOTHER|MO|725 SILLY STREET^^NOTOWN^WA^99999|(999)999-9999||NOT|
NK1|3|7-11CP||5801 OLYMPIC HWY^^ABERDEEN^WA^98520||(360)999-9999|EMP|||CHECKER|||7-11 CENTRAL PARK|
PV1|1|P|RHC.HHH|EL|||ZZZZZ^ZUPER^ZUPER^S^^ARNP^^^^^^^XX|||||||PR||||POV||CM|||||||||||||||||||ZZZ||PRE|||202106301030||||||||ZZZZZ^ZUPER^ZUPER^S^^ARNP^^^^^^^XX|
PV2|||TESTING INTERFACE RELATIONSHIP||||||||||||||||||||||EL|||||||||||N|
ROL|1|AD|AT|ZZZZZ^ZUPER^ZUPER^S^^ARNP^^^^^^^XX|
GT1|1||TEST^CPSINTERFACE^1||123 SILLY STREET^^NOTOWN^WA^99999^^^^ZZ|(999)999-9999|||||SA|999-99-9999||||7-11CP|5801 OLYMPIC HWY^^ABERDEEN^WA^98520^^^^GH|(999)999-9999|
IN1|1|PACC||PACC|13221 SW 68TH PKWY STE 200^^TIGARD^OR^97223-8328||(999)999-9999||||7-11CP|||||TEST^CPSINTERFACE^1|SA|19820504|123 SILLY STREET^^ABERDEEN^WA^98520|||||||||||||||||789456123||||||FT|M|^^ABERDEEN|
IN1|2|NALC||CIGNA/NALC|PO BOX 188004^^CHATTANOOGA^TN^37422-8004||(888)636-6252||||7-11CP|||||TEST^CPSINTERFACE^1|SA|19820504|123 SILLY STREET^^ABERDEEN^WA^98520|||||||||||||||||456789123||||||FT|M|^^ABERDEEN|
IN2|1|999-99-9999||||||||||||||||||||||||||||||||||||||||U|S||||||||||||||||||||(999)999-9999|
IN2|2|555-66-2222||||||||||||||||||||||||||||||||||||||||U|S||||||||||||||||||||(999)999-9999|
ZCD|1|ADM.ADIR^THE PATIENT'S ADVANCED DIRECTIVE IS:^ADN|
ZCD|2|ADM.HB11^Registration clerk initials:|
ZCD|3|ADM.HB8^explained?|
ZCD|4|ADM.HB9a^safety concerns?|
ZCD|5|ADM.HCB^PT given FOUR STEPS TO HEALTHCARE Brochure?|
ZCD|6|ADM.LANG^PT PREFERRED LANGUAGE:|

Tcl Script:
proc tps_reformat_gry_centricity_adt06302021 { args } {

keylget args MODE mode ;# Fetch mode

set dispList {} ;# Nothing to return

switch -exact -- $mode {
start {
# Perform special init functions
# N.B.: there may or may not be a MSGID key in args
}

run {
# 'run' mode always has a MSGID; fetch and process it

####Data variable initialization####
set data [set flddel [set compsep [set repsep [set esccharc [set subcompsep [set guarName ""]]]]]]
set segList [set Seg [set Segindex [set SegID [set IN1Length [set evn1 [set Tempfieldlist ""]]]]]]
set MSHList [set PIDfieldlist [set pidlength [set pidIdList [set pidIdType [set pidPhoneList ""]]]]]
set pidMRNList [set mrn [set ptAcct [set ROLfieldlist [set phyType [set ppDoc [set ckEmail ""]]]]]]
set newPD1Seg [set PV1fieldlist [set ptLocList [set ptLocation [set IN1fieldlist [set insSetId ""]]]]]
set pv1seg [set NK1Seg [set pv1fieldlist [set pv1Loc [set pv1LocList [set loc [set checkLoc [set ptSSN ""]]]]]]]
####Extract message
keylget args MSGID mh
set data [msgget $mh]

####Extract Defined HL7 Encoding Characters####
set flddel [string index $data 3]
set subflddel [string index $data 4]
set repsep [string index $data 5]
set esccharc [string index $data 6]
set subcompsep [string index $data 7]

####Split Message Into Segment List####
set segList [split $data "\r"]
set segindex [lsearch $segList "PV1*"]
if {$segindex > -1} {
set pv1seg [lindex $segList $segindex]
set pv1fieldlist [split $pv1seg $flddel]
set pv1Loc [lindex $pv1fieldlist 3]
set pv1LocList [split $pv1Loc $subflddel]
if {[llength $pv1LocList] > 1} {
set loc [lindex $pv1LocList 0]
} else {
set loc $pv1Loc
}
if {$loc != "" } {
set checkLoc [tbllookup centricityLocations $loc]
}
if { $checkLoc != $loc} {
lappend dispList "KILL $mh"
return $dispList
}
}
set segList [split $data "\r"]
set segindex [lsearch $segList "NK1*"]
if {$segindex > -1} {
set NK1seg [lindex $segList $segindex]
set NK1fieldlist [split $NK1seg $flddel]
set NK1Rel [lindex $NK1fieldlist 3]
set NK1RelList [split $NK1Rel $subflddel]
if {[llength $NK1RelList] > 1} {
set Rel [lindex $NK1RelList 0]
} else {
set Rel $NK1Rel
}
if {$Rel != "" } {
set MappedRel [tbllookup CPSContactRelationship $Rel]
}
echo $MappedRel
}

##REMAP Admit type and Hospital Servcie
foreach Seg $segList {
set Segindex [lsearch -exact $segList $Seg]
set SegID [string range $Seg 0 2]
switch -exact -- $SegID {
MSH {
####Replace msh-3 componet 2 with universal id#####
set MSHseg [lindex $segList $Segindex]
set MSHlist [split $MSHseg $flddel]
set MSHlist [lreplace $MSHlist 2 2 "ADM"]
set evn1 [lindex [split [lindex $MSHlist 8 ] $subflddel ] 1]
set MSHlist [lreplace $MSHlist 10 10 "P"]
set MSHlist [lreplace $MSHlist 11 11 "2.3"]
set facilityId [lindex $MSHlist 3]
set MSHseg [join $MSHlist $flddel]
set segList [lreplace $segList $Segindex $Segindex $MSHseg]
}
EVN {
set EVNseg [lindex $segList $Segindex]
set EVNfieldlist [split $EVNseg $flddel]
set EVNfieldlist [lreplace $EVNfieldlist 1 1 $evn1]
set EVNseg [join $EVNfieldlist $flddel]
set segList [lreplace $segList $Segindex $Segindex $EVNseg]
}
PID {
#### PID remaps####
set PIDseg [lindex $segList $Segindex]
set PIDfieldlist [split $PIDseg $flddel]
#### Add Segments if less than 20
set pidlength [llength $PIDfieldlist]
while {$pidlength < 41} {
lappend PIDfieldlist {}
set pidlength [llength $PIDfieldlist]
}
set MRNlist [lindex $PIDfieldlist 3]
if {[string first ~ $MRNlist] < 0} {
set MRNfieldlist [split $MRNlist $subflddel]
set MRNflag [lindex $MRNfieldlist 4]
} else {
set Tempfieldlist [split $MRNlist "~"]
set MRNfieldlist0 [lindex $Tempfieldlist 0]
set MRNfieldlist [split $MRNfieldlist0 $subflddel]
set MRNflag [lindex $MRNfieldlist 4]
}
#### Concatenate MRN and patient account separated by a dash and move to PID-4
set ptAcct [lindex $PIDfieldlist 18]
if {$MRNflag eq "MR"} {
set mrn [lindex $MRNfieldlist 0]
set PIDfieldlist [lreplace $PIDfieldlist 2 2 $mrn]
set PIDfieldlist [lreplace $PIDfieldlist 4 4 $mrn]
set PIDfieldlist [lreplace $PIDfieldlist 3 3 $mrn-$ptAcct]
} else {
set PIDfieldlist [lreplace $PIDfieldlist 3 3 $ptAcct]
}
#### Add quotes to PID-11.2 Second Address if not populated - prevents issues in Centricity
set pidAddList [split [lindex $PIDfieldlist 11] $subflddel]
set pidAddLen [llength $pidAddList]
while {$pidAddLen < 3} {
lappend pidAddList {}
set pidAddLen [llength $pidAddList]
}

set pidAltAddress [lindex $pidAddList 1]
if {$pidAltAddress == ""} {
set pidAddList [lreplace $pidAddList 1 1 \"\"]
set pidAddList [join $pidAddList $subflddel]
set PIDfieldlist [lreplace $PIDfieldlist 11 11 $pidAddList]

}
#### IF email is not populated hardcode "NONE" in PID-13.3
set pidPhoneList [split [lindex $PIDfieldlist 13] $subflddel]
set pidPhoneLen [llength $pidPhoneList]
while {$pidPhoneLen < 4} {
lappend pidPhoneList {}
set pidPhoneLen [llength $pidPhoneList]
}
set ckEmail [lindex $pidPhoneList 4]
if {$ckEmail != "" } {
set pidPhoneList [lreplace $pidPhoneList 3 3 "NONE"]
set pidPhoneList [join $pidPhoneList $subflddel]
set PIDfieldlist [lreplace $PIDfieldlist 13 13 $pidPhoneList]
}
#### Truncate SSN to 11 Characters
set ptSSN [lindex $PIDfieldlist 19]
set lenPtSSN [string length $ptSSN]
if {$lenPtSSN > 11} {
set newSSN [string range $ptSSN 0 10]
set PIDfieldlist [lreplace $PIDfieldlist 19 19 $newSSN]
}
#### Map Ethnicity PID-22
#######################################

#### Hardcode preferred contact to "H" home phone
set PIDfieldlist [lreplace $PIDfieldlist 40 40 "H"]
set PIDseg [join $PIDfieldlist $flddel]
set segList [lreplace $segList $Segindex $Segindex $PIDseg]
}

ROL {
####Create PD1 Segment - capture primary care physician####
set ROLseg [lindex $segList $Segindex]
set ROLfieldlist [split $ROLseg $flddel]
set phyType [lindex $ROLfieldlist 3]
set ppDoc [lindex $ROLfieldlist 4]
if { $phyType eq "PP" } {
if { $ppDoc != "" } {
set newPD1Seg "PD1||||$ppDoc"
set segList [lreplace $segList $Segindex $Segindex $newPD1Seg]
} else {
set segList [lreplace $segList $Segindex $Segindex]
}
} else {
set segList [lreplace $segList $Segindex $Segindex]
}
}
AL1 {
####Remove DG1 ####
set segList [lreplace $segList $Segindex $Segindex]
}
PV1 {
#### PV1 remaps####
set PV1seg [lindex $segList $Segindex]
set PV1fieldlist [split $PV1seg $flddel]
#set ptLocList [split [lindex $PV1fieldlist 3] $subflddel]
if { $loc != "" } {
set PV1fieldlist [lreplace $PV1fieldlist 3 3 ^^^$loc]
}
if { $ppDoc != "" } {
set PV1fieldlist [lreplace $PV1fieldlist 7 7 $ppDoc]
}
set PV1fieldlist [lreplace $PV1fieldlist 10 10 ""]
set PV1fieldlist [lreplace $PV1fieldlist 18 18 ""]
set PV1fieldlist [lreplace $PV1fieldlist 36 36 ""]
set PV1fieldlist [lreplace $PV1fieldlist 39 39 ""]
set PV1fieldlist [lreplace $PV1fieldlist 41 41 ""]
set PV1fieldlist [lreplace $PV1fieldlist 44 44 ""]
set PV1seg [join $PV1fieldlist $flddel]
set segList [lreplace $segList $Segindex $Segindex $PV1seg]
}
PV2 {
####Remove PV2####
set segList [lreplace $segList $Segindex $Segindex]
}
NK1 {
#### NK1 remaps####
set NK1seg [lindex $segList $Segindex]
set NK1fieldlist [split $NK1seg $flddel]
if { $Rel != "" } {
set NK1fieldlist [lreplace $NK1fieldlist 3 3 $MappedRel]
set NK1seg [join $NK1fieldlist $flddel]
set segList [lreplace $segList $Segindex $Segindex $NK1seg]
}
}
GT1 {
set GT1seg [lindex $segList $Segindex]
set GT1fieldlist [split $GT1seg $flddel]
set guarName [lindex $GT1fieldlist 3]
if { $guarName != "" } {
set segList [lreplace $segList $Segindex $Segindex $GT1seg]
} else {
set segList [lreplace $segList $Segindex $Segindex]
}
}
OBX {
####Remove OBX ####
set segList [lreplace $segList $Segindex $Segindex]
}
DG1 {
####Remove DG1 ####
set segList [lreplace $segList $Segindex $Segindex]
}
PR1 {
####Remove PR1 ####
set segList [lreplace $segList $Segindex $Segindex]
}


#### Remove GT1 if no name in GT1-3

ZCD {
####Remove ZCD ####
set segList [lreplace $segList $Segindex $Segindex]
}
default {}
}
}
set data [join $segList "\r"]
msgset $mh $data
lappend dispList "CONTINUE $mh"
}
time {
# Timer-based processing
# N.B.: there may or may not be a MSGID key in args

}

shutdown {
# Doing some clean-up work

}

default {
error "Unknown mode '$mode' in tps_reformat_gry_centricity_adt06302021"
}
}

return $dispList
}

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close