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

LA7VLIN2.m

Go to the documentation of this file. 
  1. LA7VLIN2 ;VA/DALOI/JMC - Process Incoming UI Msgs, continued ;JUL 06, 2010 3:14 PM
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,1027**;NOV 01, 1997
  1.  ;This routine is a continuation of LA7VIN1 and is only called from there.
  1.  Q
  1.  ;
  1. MSH ; Process MSH segment
  1.  N LA7X
  1.  ;
  1.  I $E(LA7SEG(0),1,3)'="MSH" D  Q
  1.  . S (LA7ABORT,LA7ERR)=7
  1.  . D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  ; Encoding characters
  1.  S LA7FS=$E(LA7SEG(0),4)
  1.  S LA7CS=$E(LA7SEG(0),5)
  1.  S LA7ECH=$E(LA7SEG(0),5,8)
  1.  ; No field or component seperator
  1.  I LA7FS=""!(LA7CS="") D
  1.  . S (LA7ABORT,LA7ERR)=8
  1.  . D CREATE^LA7LOG(LA7ERR)
  1.  ;
  1.  ; Sending application
  1.  S LA7SAP=$$P^LA7VHLU(.LA7SEG,3,LA7FS)
  1.  S LA7ID=LA7SAP_"-I-"
  1.  ;
  1.  ; Sending facility
  1.  S LA7SFAC=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
  1.  ;
  1.  ; Receiving application
  1.  S LA7RAP=$$P^LA7VHLU(.LA7SEG,5,LA7FS)
  1.  ;
  1.  ; Receiving facility
  1.  S LA7RFAC=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
  1.  ;
  1.  ; Message date/time from first component
  1.  S LA7MEDT=$$HL7TFM^XLFDT($P($$P^LA7VHLU(.LA7SEG,7,LA7FS),LA7CS),"L")
  1.  ;
  1.  ; Message type
  1.  S LA7X=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
  1.  S LA7MTYP=$P(LA7X,LA7CS,1)
  1.  ;
  1.  ; Message Control ID
  1.  S LA7MID=$$P^LA7VHLU(.LA7SEG,10,LA7FS)
  1.  ;
  1.  ; HL7 version
  1.  S LA7X=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
  1.  S LA7HLV=$P(LA7X,LA7CS,1)
  1.  Q
  1.  ;
  1.  ;
  1. ORC ; Process ORC segment
  1.  N LA7X,LA7Y
  1.  ;
  1.  ; Order control
  1.  S LA7OTYPE=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
  1.  ;
  1.  ; Place order number
  1.  S LA7PON=$$P^LA7VHLU(.LA7SEG,3,LA7FS)
  1.  ;
  1.  ; Setup shipping manifest variable
  1.  S LA7Y=0
  1.  S LA7X=$P($$P^LA7VHLU(.LA7SEG,5,LA7FS),LA7CS)
  1.  I LA7X'="" S LA7Y=$O(^LAHM(62.8,"B",LA7X,0))
  1.  I LA7Y S LA7628=LA7Y
  1.  S LA7SM=LA7Y_"^"_LA7X
  1.  ;
  1.  ; Setup shipping configuration variable
  1.  I $P(LA7SM,"^") S LA7629=+$P($G(^LAHM(62.8,$P(LA7SM,"^"),0)),"^",2)
  1.  E  S LA7629=0
  1.  ;
  1.  ; Set new order/shipping mainfest received alert/identifiers
  1.  I LA7MTYP="ORM",$L($P(LA7SM,"^",2)) D
  1.  . S ^TMP("LA7-ORM",$J,LA76248,LA76249,$P(LA7SM,"^",2))=""
  1.  . D SETID^LA7VHLU1(LA76249,LA7ID,$P(LA7SM,"^",2))
  1.  ;
  1.  ; Order quantity/timing (duration, units, urgency)
  1.  S LA7ODUR=$P($$P^LA7VHLU(.LA7SEG,8,LA7FS),LA7CS,3)
  1.  S LA7ODURU=$P($$P^LA7VHLU(.LA7SEG,8,LA7FS),LA7CS,4)
  1.  S LA7OUR=$P($$P^LA7VHLU(.LA7SEG,8,LA7FS),LA7CS,6)
  1.  ;
  1.  ; Date/time of transaction
  1.  S LA7ORDT=$$HL7TFM^XLFDT($P($$P^LA7VHLU(.LA7SEG,10,LA7FS),LA7CS),"L")
  1.  ;
  1.  ; Placer's entered by (id^duz^last name, first name, mi [id])
  1.  S LA7X=$$P^LA7VHLU(.LA7SEG,11,LA7FS)
  1.  S LA7PEB=$$XCNTFM^LA7VHLU4(LA7X,LA7ECH)
  1.  I LA7PEB="^^" S LA7PEB=""
  1.  ;
  1.  ; Placer's verified by (id^duz^last name, first name, mi [id])
  1.  S LA7X=$$P^LA7VHLU(.LA7SEG,12,LA7FS)
  1.  S LA7PVB=$$XCNTFM^LA7VHLU4(LA7X,LA7ECH)
  1.  I LA7PVB="^^" S LA7PVB=""
  1.  ;
  1.  ; Placer's ordering provider (id^duz^last name, first name, mi [id])
  1.  S LA7X=$$P^LA7VHLU(.LA7SEG,13,LA7FS)
  1.  S LA7POP=$$XCNTFM^LA7VHLU4(LA7X,LA7ECH)
  1.  I LA7POP="^^" S LA7POP=""
  1.  ;
  1.  ; Enterer's ordering location
  1.  S LA7X=$$P^LA7VHLU(.LA7SEG,14,LA7FS)
  1.  S LA7Y=$$PLTFM^LA7VHLU4(LA7X,LA7ECH)
  1.  S LA7EOL=$P(LA7Y,"^",1,3)
  1.  I LA7EOL="^^" S LA7EOL=""
  1.  ;
  1.  ; Order control code reason
  1.  S LA7OCR=$$P^LA7VHLU(.LA7SEG,17,LA7FS)
  1.  ;
  1.  ;
  1.  ; If ORM order message, determine specimen collecting site from ORC
  1.  ; segment, if none use MSH sending facility value
  1.  S LA7CSITE=""
  1.  I LA7MTYP="ORM" D
  1.  . S LA7X=$P($$P^LA7VHLU(.LA7SEG,18,LA7FS),LA7CS)
  1.  . S LA7CSITE=$$FINDSITE^LA7VHLU2(LA7X,2,1)
  1.  . I LA7CSITE'>0 S LA7CSITE=$$FINDSITE^LA7VHLU2(LA7SFAC,2,0)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. NTE ; Process NTE segment
  1.  ; NTE segments contain comments from instruments or other facilities.
  1.  ; NTE segments following OBR's contain comments which refer to the entire test battery.
  1.  ; NTE segments following OBX's contain comments which are test specific.
  1.  ;
  1.  ; For comments in ORU messages:
  1.  ;  Test specific comments can be prefaced with a site defined prefix -
  1.  ;  see field REMARK PREFIX (#19) in CHEM TEST multiple of AUTOMATED INSTRUMENT (#62.4 file.
  1.  ;  There can be more than one NTE, each will be stored as a comment in ^LAH.
  1.  ;
  1.  N LA7,LA7I,LA7NTE,LA7SOC
  1.  ;
  1.  S LA7SOC=$$P^LA7VHLU(.LA7SEG,3,LA7FS)
  1.  S LA7NTE=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
  1.  ;
  1.  ; Trim trailing spaces.
  1.  I LA7NTE'="" S LA7NTE=$$TRIM^XLFSTR(LA7NTE,"R"," ")
  1.  I LA7NTE="" S LA7NTE=" "
  1.  ;
  1.  I LA7MTYP="ORM" D OCOM Q
  1.  ;
  1.  ; Check for repeating comments in NTE segment and process
  1.  ; If "^" in remark then translate to "~" to store.
  1.  F LA7I=1:1:$L(LA7NTE,$E(LA7ECH,2)) D
  1.  . S LA7RMK=$P(LA7NTE,$E(LA7ECH,2),LA7I)
  1.  . I LA7RMK="" Q
  1.  . S LA7RMK=$$UNESC^LA7VHLU3(LA7RMK,LA7FS_LA7ECH)
  1.  . I LA7RMK["^" S LA7RMK=$TR(LA7RMK,"^","~")
  1.  . I LA7MTYP="ORU" D RCOM Q
  1.  . I LA7MTYP="ORR",$G(LA7OTYPE)="UA" D RCOM Q
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. PID ; Process PID segment
  1.  N LA7X,LA7Y,X,Y
  1.  ;
  1.  S (DFN,LA7DOB,LA7ICN,LA7PRACE,LA7PNM,LA7PTID2,LA7PTID3,LA7PTID4,LA7SEX,LA7SSN,LRDFN,LRTDFN)=""
  1.  ;
  1.  ; PID Set ID
  1.  S LA7SPID=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
  1.  ;
  1.  ; Extract patient identifiers
  1.  S LA7PTID2=$$P^LA7VHLU(.LA7SEG,3,LA7FS)
  1.  S LA7PTID3=$$P^LA7VHLU(.LA7SEG,4,LA7FS)
  1.  S LA7PTID4=$$P^LA7VHLU(.LA7SEG,5,LA7FS)
  1.  ; Resolve ICN if identifier is from MPI
  1.  ; Assume SSN is identifier is "SS" or blank
  1.  F I=1:1:$L(LA7PTID3,$E(LA7ECH,2)) D
  1.  . N J,LA7X,LA7ID
  1.  . S X=$P(LA7PTID3,$E(LA7ECH,2),I) Q:'$L(X)
  1.  . S LA7PTID3(I)=X,LA7ID=$P(LA7PTID3(I),$E(LA7ECH),5)
  1.  . I LA7ID'="","NI^PI"[LA7ID D  Q
  1.  . . S Y=$P(LA7PTID3(I),$E(LA7ECH))
  1.  . . I Y?10N1"V"6N S LA7Y=Y
  1.  . . E  S LA7Y=Y_"V"_$P(LA7PTID3(I),$E(LA7ECH),2)
  1.  . . S LA7X=$$CHKICN^LA7VHLU2(LA7Y)
  1.  . . I LA7X>0 S DFN=$P(LA7X,"^"),LA7ICN=$P(LA7X,"^",2)
  1.  . I LA7ID="SS"!(LA7ID="") D  Q
  1.  . . F J=1:1:3 S LA7X(J)=$P(LA7PTID3(I),$E(LA7ECH),J)
  1.  . . I LA7X(1)'?9N.1A Q
  1.  . . I LA7X(3)="M11",LA7X(2)'=$P($$M11^HLFNC(LA7X(1),LA7ECH),$E(LA7ECH),2) Q
  1.  . . S LA7SSN=LA7X(1),DFN=$O(^DPT("SSN",LA7SSN,0))
  1.  ;
  1.  ; Check PID-2 (alternate patient id) if PID-3 did not yield SSN/ICN
  1.  F I=1:1:$L(LA7PTID2,$E(LA7ECH,2)) D
  1.  . N J,LA7X,LA7ID
  1.  . S X=$P(LA7PTID2,$E(LA7ECH,2),I) Q:'$L(X)
  1.  . S LA7PTID2(I)=X,LA7ID=$P(LA7PTID2(I),$E(LA7ECH),5)
  1.  . I LA7ICN="",LA7ID'="","NI^PI"[LA7ID D  Q
  1.  . . S Y=$P(LA7PTID2(I),$E(LA7ECH))
  1.  . . I Y?10N1"V"6N S LA7Y=Y
  1.  . . E  S LA7Y=Y_"V"_$P(LA7PTID2(I),$E(LA7ECH),2)
  1.  . . S LA7X=$$CHKICN^LA7VHLU2(LA7Y)
  1.  . . I LA7X>0 S DFN=$P(LA7X,"^"),LA7ICN=$P(LA7X,"^",2)
  1.  . I LA7SSN="",LA7ID="SS"!(LA7ID="") D  Q
  1.  . . F J=1:1:3 S LA7X(J)=$P(LA7PTID2(I),$E(LA7ECH),J)
  1.  . . I LA7X(1)'?9N.1A Q
  1.  . . I LA7X(3)="M11",LA7X(2)'=$P($$M11^HLFNC(LA7X(1),LA7ECH),$E(LA7ECH),2) Q
  1.  . . S LA7SSN=LA7X(1),DFN=$O(^DPT("SSN",LA7SSN,0))
  1.  ;
  1.  ; Extract patient name
  1.  S LA7X=$$P^LA7VHLU(.LA7SEG,6,LA7FS)
  1.  I LA7X'="" S LA7PNM=$$FMNAME^HLFNC(LA7X,LA7ECH)
  1.  ;
  1.  ; Extract date of birth
  1.  ; Check for degree of precision in 2nd component to provide backward compatibility with HL7 <v2.3
  1.  S LA7X=$$P^LA7VHLU(.LA7SEG,8,LA7FS)
  1.  I LA7X D
  1.  . S LA7Y=$P(LA7X,LA7CS,2),LA7X=$P(LA7X,LA7CS,1)
  1.  . I (LA7Y=""!(LA7Y="D")),$E(LA7X,9,12)="0000" S LA7X=$E(LA7X,1,8)
  1.  . S LA7DOB=$$HL7TFM^XLFDT(LA7X)
  1.  . I LA7DOB<1 S LA7DOB=""
  1.  . I LA7Y="L" S LA7DOB=$E(LA7DOB,1,5)_"00"
  1.  . I LA7Y="Y" S LA7DOB=$E(LA7DOB,1,3)_"0000"
  1.  ;
  1.  ; Extract patient's sex
  1.  S LA7SEX=$$P^LA7VHLU(.LA7SEG,9,LA7FS)
  1.  ;
  1.  ; Extract patient's race
  1.  S LA7X=$$P^LA7VHLU(.LA7SEG,11,LA7FS)
  1.  I $P(LA7X,LA7CS)'="" D
  1.  . I $P(LA7X,LA7CS,3)="0005" S $P(LA7X,LA7CS,3)="HL70005"
  1.  . S LA7PRACE=$P(LA7X,LA7CS)_":"_$P(LA7X,LA7CS,2)_$S($P(LA7X,LA7CS,3)'="":":"_$P(LA7X,LA7CS,3),1:"")
  1.  ;
  1.  ; Extract patient's SSN and determine DFN
  1.  ; If SSN determined previously from PID-3 then compare SSN's
  1.  ; If DFN determined previously from ICN then check DFN based on SSN.
  1.  S LA7X=$P($$P^LA7VHLU(.LA7SEG,20,LA7FS),LA7CS)
  1.  S LA7X=$TR(LA7X,"-","") ; remove "-" if any
  1.  I LA7X?9N.1A D
  1.  . I LA7SSN'="",LA7X'=LA7SSN Q
  1.  . S LA7SSN=LA7X
  1.  . I DFN,DFN'=$O(^DPT("SSN",LA7SSN,0)) Q
  1.  . S DFN=$O(^DPT("SSN",LA7SSN,0))
  1.  I DFN D
  1.  . S LRDFN=$P($G(^DPT(DFN,"LR")),"^")
  1.  . S LRTDFN=$P($G(^DPT(DFN,"LRT")),"^")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. PV1 ; Process PV1 segment
  1.  ;
  1.  ; PV1 Set ID
  1.  S LA7SPV1=$$P^LA7VHLU(.LA7SEG,2,LA7FS)
  1.  ;
  1.  ; Extract ordering location
  1.  S LA7LOC=$P($$P^LA7VHLU(.LA7SEG,4,LA7FS),LA7CS)
  1.  Q
  1.  ;
  1.  ;
  1. RCOM ; Store result comments in ORU messages
  1.  ;
  1.  ; Don't store remark if same as specimen comment (without "~").
  1.  I $G(LA7AA),$G(LA7AD),$G(LA7AN),LA7RMK=$TR($P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,3)),"^",6),"~") Q
  1.  ; Or patient info (#.091 in file 63) - info previously downloaded
  1.  I $G(LA7AA),$G(LA7AD),$G(LA7AN),LA7RMK=$G(^LR(+$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),.091)) Q
  1.  ;
  1.  ; If test specific, store comment prefix with comments (see LA7VIN5)
  1.  I $O(LA7RMK(0,0)) D  Q
  1.  . N LA7I
  1.  . S LA7I=0
  1.  . F  S LA7I=$O(LA7RMK(0,LA7I)) Q:'LA7I  D
  1.  . . I '$P(LA7RMK(0,LA7I),"^") Q
  1.  . . ; Don't store if status not "FINAL"
  1.  . . I $P(LA7RMK(0,LA7I),"^")=2,"CFU"'[$G(LA7ORS) Q
  1.  . . D RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,$P(LA7RMK(0,LA7I),"^",2))
  1.  ;
  1.  ; Store comment in 1 node of ^LAH global
  1.  I $P(LA7624(0),"^",17) D RMKSET^LASET(LA7LWL,LA7ISQN,LA7RMK,"")
  1.  K LA7RMK
  1.  Q
  1.  ;
  1.  ;
  1. OCOM ; Store order comments from ORM messages in file #69.6
  1.  ; Check for repeating comments in NTE segment and process
  1.  ; If "^" in remark then translate to "~" to store.
  1.  ;
  1.  ; If source of comment (LA7SOC) is "RQ" then comment is from CHCS which
  1.  ; uses a composite data type for NTE-3. VistA only extracts component #9
  1.  ; which contains the external value of the comment.
  1.  ;
  1.  N LA7DIE,LA7RMK,LA7WP,X
  1.  I $G(LA7696)<1 Q
  1.  F LA7I=1:1:$L(LA7NTE,$E(LA7ECH,2)) D
  1.  . S LA7RMK=$P(LA7NTE,$E(LA7ECH,2),LA7I)
  1.  . I LA7SOC="RQ" D
  1.  . . S X=$P(LA7RMK,$E(LA7ECH),9)
  1.  . . I X'="" S LA7RMK=X
  1.  . I LA7RMK="" Q
  1.  . S LA7RMK=$$UNESC^LA7VHLU3(LA7RMK,LA7FS_LA7ECH)
  1.  . I LA7RMK["^" S LA7RMK=$TR(LA7RMK,"^","~")
  1.  . S LA7WP(LA7I,0)=LA7RMK
  1.  D WP^DIE(69.6,LA7696_",",99,"A","LA7WP","LA7DIE(99)")
  1.  Q