david98031

Untitled

Jun 5th, 2020
157
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ######################################################################
  2. # Name: oru_file_xfr
  3. # Purpose: <description>
  4. # UPoC type: tps
  5. # Args: tps keyedlist containing the following keys:
  6. # MODE run mode ("start", "run" or "time")
  7. # MSGID message handle
  8. # ARGS user-supplied arguments:
  9. # <describe user-supplied args here>
  10. #
  11. # Returns: tps disposition list:
  12. # <describe dispositions used here>
  13. #
  14.  
  15. #{ ECODIR /hci/testfiles/epic/incoming/xim } { FTPSERVER austera } { FTPUSER valleymed/hciuser } { FTPPASS xxxxx } { OLDPATH ^//cardioserver } { NEWPATH //austera/xim/test } {CMAXOBDIR /tmp/opt2/cmaxftp/} { USECURL N }
  16.  
  17. proc tps_xper_pdf_ext { args } {
  18. keylget args MODE mode ;# Fetch mode
  19. global env HciConnName mh_pdf_msg
  20. set dispList {} ;# Nothing to return
  21.  
  22. switch -exact -- $mode {
  23. start {
  24. # Perform special init functions
  25. # N.B.: there may or may not be a MSGID key in args
  26. }
  27.  
  28. run {
  29. # 'run' mode always has a MSGID; fetch and process it
  30. keylget args MSGID mh
  31. keylget args ARGS.TEMPDIR tempdir
  32. keylget args ARGS.FTPSERVER ftpserver
  33. keylget args ARGS.FTPUSER ftpuser
  34. keylget args ARGS.FTPPASS ftppass
  35. keylget args ARGS.OLDPATH oldpath
  36. keylget args ARGS.NEWPATH newpath
  37. keylget args ARGS.CMAXOBDIR cmaxobdir
  38. keylget args ARGS.PATHLOC pathloc
  39.  
  40. set disposition "CONTINUE"
  41. set msg [msgget $mh]
  42. package require hl7
  43. set hl7 [hl7::parse_msg $msg]
  44.  
  45. # Get the file path from the message
  46. set fpath [hl7::get_field hl7 $pathloc]
  47.  
  48. if { [regexp {\\E\\} $fpath] } {
  49. set fpath [unescape $fpath [string range $msg 3 7]]
  50. }
  51.  
  52. #echo "fpath = $fpath"
  53. set fpath [string map { "\\" "/" } $fpath]
  54. echo "fpath = $fpath"
  55.  
  56. # replace the cardioserver path with the austera path
  57. regsub -nocase $oldpath $fpath $newpath ftppath
  58. echo "ftp path = $ftppath"
  59. set url "ftp:$ftppath"
  60.  
  61. set cmd "/usr/bin/GET -C $ftpuser:$ftppass $url"
  62. echo "cmd = $cmd"
  63. set perl5lib $env(PERL5LIB)
  64. array unset env PERL5LIB
  65. set mid [msgmetaget $mh MID]
  66. set file $tempdir/[keylget mid DOMAIN].[keylget mid HUB].[keylget mid NUM].pdf
  67. echo "file = $file"
  68. #set errCode 0
  69. set errCode [catch {exec sh -c $cmd | pdftotext -layout - - | tr -d '\014'} errMsg]
  70. echo "errCode = $errCode"
  71. if { $errCode } {
  72. #parray env
  73. echo error retrieving PDF from source system: $errMsg ($fpath)
  74. set env(PERL5LIB) $perl5lib
  75. #file delete $file
  76. return "{ERROR $mh}"
  77. set disposition "ERROR"
  78. }
  79. set env(PERL5LIB) $perl5lib
  80. #The following two lines and commenting out of the following 4 lines
  81. #are a response to data encoding issues introduced in 5.8
  82. set txtmsg $errMsg
  83.  
  84. set txtmsg [regsub -all {\xA0} $txtmsg " "]
  85. set txtmsg [regsub -all {\xAD} $txtmsg "-"]
  86.  
  87. hl7::set_field hl7 MSH.12 "2.2"
  88. hl7::delete_seg hl7 ORC
  89. hl7::delete_seg hl7 ZDS
  90.  
  91. hl7::set_field hl7 OBR.2 [hl7::get_field hl7 OBR.18]
  92. hl7::set_field hl7 OBR.3 [hl7::get_field hl7 OBR.18]
  93.  
  94. foreach msgtype { RTF TXT } {
  95. hl7::set_field hl7 MSH.4 $msgtype
  96. if { $msgtype eq "RTF" } {
  97. set lines [split $txtmsg "\n"]
  98. set new "{\\rtf1\\ansi{\\fonttbl\\f0 Courier;}\\f0\\fs16\\pard "
  99. for { set i 0 } { $i < [llength $lines] } { incr i } {
  100. set data [lindex $lines $i]
  101. if { $i > 1 } {
  102. append new "\\par "
  103. }
  104. set data [string map { "\\" "\\\\" "{" "\\{" "}" "\\}" } $data]
  105. append new $data
  106. }
  107. append new "}"
  108. set new [string map { "|" "\\F\\" "^" "\\S\\" "~" "\\R\\" "\\" "\\E\\" "&" "\\T\\" } $new]
  109. hl7::set_field hl7 OBX.2 "FT"
  110. hl7::set_field hl7 OBX.3 "&GDT"
  111. hl7::set_field hl7 OBX.4 ""
  112. hl7::set_field hl7 OBX.5 $new
  113. } else {
  114. set linenum 1
  115. foreach line [split [string trimright $txtmsg " \n"] \n] {
  116. if { $linenum > 1 } {
  117. hl7::append_seg hl7 OBX
  118. }
  119. hl7::set_field hl7 OBX($linenum).1 $linenum
  120. hl7::set_field hl7 OBX($linenum).2 "TX"
  121. hl7::set_field hl7 OBX($linenum).3 "&GDT"
  122. hl7::set_field hl7 OBX($linenum).4 ""
  123. hl7::set_field hl7 OBX($linenum).5 $line
  124. incr linenum
  125. }
  126. set mh [msgcopy $mh]
  127. }
  128. msgset $mh [hl7::join_msg hl7]
  129.  
  130. lappend dispList "$disposition $mh"
  131. }
  132.  
  133. file delete $file
  134. }
  135.  
  136. time {
  137. # Timer-based processing
  138. # N.B.: there may or may not be a MSGID key in args
  139. }
  140.  
  141. shutdown {
  142. # Doing some clean-up work
  143. }
  144. }
  145.  
  146. echo oru_file_xfer_to_epic complete
  147. return $dispList
  148. }
RAW Paste Data