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

HLTPCK1.m

Go to the documentation of this file. 
  1. HLTPCK1 ;AISC/SAW-Header Validation Routine (non-TCP link) ;09/13/2006
  1.  ;;1.6;HEALTH LEVEL SEVEN;**8,36,59,120,133**;Oct 13, 1995;Build 13
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1. CHK(HDR,ARY,MSA) ;Validate Data in Header Segment (MSH, BHS or FHS) of
  1.  ;an HL7 Message through non-TCP link
  1.  ;
  1.  ;This entry point is a subroutine call with parameter passing that
  1.  ;will return an array (ARY()) consisting of values extracted from
  1.  ;the message header segment subscripted by the mnemonics for each of
  1.  ;the message header fields and components
  1.  ;If an error is encountered during validation, the array parameter
  1.  ;(ARY) will be set equal to two pieces, error #^error text
  1.  ;
  1.  ;Required input parameters:
  1.  ;  HDR = Message header segment
  1.  ;
  1.  ;  ARY = The array in which the message header values will be
  1.  ;          returned
  1.  ;  Note:  The ARY parameter must be passed by reference
  1.  ;
  1.  ;Optional input parameter:
  1.  ;  MSA = A variable which contains the message acknowledgement values:
  1.  ;          acknowledgement code^message control ID^text message
  1.  ;
  1.  ;Check for required parameters
  1.  N ERR S ERR=""
  1.  I $G(HDR)']"" S ERR="7^"_$G(^HL(771.7,7,0))_" at CHK^HLTPCK1 entry point" G EXIT
  1.  N ECH,HLN,FS,X,X1,X2
  1.  S ARY="",ARY("Q")=""""""
  1.  ;
  1.  ;Validate field separator and encoding characters
  1.  S (ARY("FS"),FS)=$E(HDR,4)
  1.  I FS']"" S ERR="Field Separator Missing" G EXIT
  1.  I FS?.C S ERR="Invalid Field Separator" G EXIT
  1.  S (ARY("ECH"),ECH)=$P(HDR,FS,2)
  1.  I ECH']"" S ERR="Encoding Characters Missing" G EXIT
  1.  I ECH?.C S ERR="Invalid Encoding Characters" G EXIT
  1.  ;
  1.  ; patch HL*1.6*120 start
  1.  ; patch HL*1.6*133
  1.  ; escape and sub-component characters are optional
  1.  ; I $L(ECH)'=4 S ERR="Invalid Encoding Characters" G EXIT
  1.  I $L(ECH)<1 S ERR="Invalid Encoding Characters" G EXIT
  1.  S ECH(1)=$E(ECH)
  1.  S ECH(2)=$E(ECH,2)
  1.  S ECH(3)=$E(ECH,3)
  1.  S ECH(4)=$E(ECH,4)
  1.  S ARY("HDR")=HDR
  1.  S ARY("HDR-1")=$E(HDR,1,3)
  1.  ;
  1.  ;Validate Message Header Type
  1.  ; I "FHS,BHS,MSH"'[$E(HDR,1,3) S ERR="Invalid Message Header Segment" G EXIT
  1.  I "FHS,BHS,MSH"'[ARY("HDR-1") S ERR="Invalid Message Header" G EXIT
  1.  ;
  1.  ;Extract data from message header segment
  1.  ; I $E(HDR,1,3)="BHS"!($E(HDR,1,3)="FHS") D
  1.  I ARY("HDR-1")="BHS"!(ARY("HDR-1")="FHS") D
  1.  . ;S ARY("DTM")=$P(HDR,FS,7),ARY("MID")=$P(HDR,FS,11),X=$P(HDR,FS,9),ARY("PID")=$P(X,$E(ECH),2),ARY("MTN")=$P($P(X,$E(ECH),3),$E(ECH,2)),ARY("ETN")=$P($P(X,$E(ECH),3),$E(ECH,2),2),ARY("VER")=$P(X,$E(ECH),4)
  1.  . S ARY("DTM")=$P(HDR,FS,7)
  1.  . S ARY("MID")=$P(HDR,FS,11)
  1.  . S ARY("PID")=""
  1.  . S ARY("MTN")=""
  1.  . S ARY("ETN")=""
  1.  . S ARY("VER")=""
  1.  . ;
  1.  . ; BHS-9, Batch name/ID/type:
  1.  . ; 2nd component: Processing id <sub> Processing mode
  1.  . ; 3rd component: message type <sub> event type
  1.  . ; 4th component: version
  1.  . S X=$P(HDR,FS,9)
  1.  . I X]"" D
  1.  .. S ARY("HDR-9")=X
  1.  .. ; original implementation incorrectly treats repetition separator as
  1.  .. ; subcomponent separator
  1.  .. S ECH("SUB-COMPONENT")=ECH(2)
  1.  .. ; if subcomponent separator is correctly applied
  1.  .. ; patch HL*1.6*133
  1.  .. ; I X[ECH(4) S ECH("SUB-COMPONENT")=ECH(4)
  1.  .. I ECH(4)]"",X[ECH(4) S ECH("SUB-COMPONENT")=ECH(4)
  1.  .. ;
  1.  .. S ARY("PID")=$P(X,ECH(1),2)
  1.  .. ; patch HL*1.6*133
  1.  .. ; I ARY("PID")[ECH("SUB-COMPONENT") D
  1.  .. I ECH("SUB-COMPONENT")]"",ARY("PID")[ECH("SUB-COMPONENT") D
  1.  ... ; 2nd sub-component is Processing mode
  1.  ... S ARY("PMOD")=$P(ARY("PID"),ECH("SUB-COMPONENT"),2)
  1.  ... ; first sub-component is Processing id
  1.  ... S ARY("PID")=$P(ARY("PID"),ECH("SUB-COMPONENT"))
  1.  .. ;
  1.  .. S ARY("MTN")=$P(X,ECH(1),3)
  1.  .. ; 2nd sub-component is event type
  1.  .. ;
  1.  .. ; patch HL*1.6*133 start
  1.  .. ; S ARY("ETN")=$P(ARY("MTN"),ECH("SUB-COMPONENT"),2)
  1.  .. I ECH("SUB-COMPONENT")]"" D
  1.  ... S ARY("ETN")=$P(ARY("MTN"),ECH("SUB-COMPONENT"),2)
  1.  .. ; 1st sub-component is message type
  1.  .. ; S ARY("MTN")=$P(ARY("MTN"),ECH("SUB-COMPONENT"))
  1.  .. I ECH("SUB-COMPONENT")]"" D
  1.  ... S ARY("MTN")=$P(ARY("MTN"),ECH("SUB-COMPONENT"))
  1.  .. ; patch HL*1.6*133 end
  1.  .. ;
  1.  .. S ARY("VER")=$P(X,ECH(1),4)
  1.  . ;
  1.  . ; BHS-10, batch comment
  1.  . ; S:$P(HDR,FS,10)]"" MSA=$P($P(HDR,FS,10),$E(ECH),1),$P(MSA,FS,2)=$P(HDR,FS,12),$P(MSA,FS,3)=$P($P(HDR,FS,10),$E(ECH),2)
  1.  . ; first component: MSA-1, acknowledgment code
  1.  . ; 2nd component: MSA-3, text message
  1.  . ;
  1.  . S X=$P(HDR,FS,10)
  1.  . I X]"" D
  1.  .. S ARY("HDR-10")=X
  1.  .. ; MSA-1, acknowledgment code: AA,AE,AR,CA,CE,CR
  1.  .. S MSA=$P(X,ECH(1),1)
  1.  .. ; MSA-2 and BHS-12, reference batch control id
  1.  .. S $P(MSA,FS,2)=$P(HDR,FS,12)
  1.  .. ; MSA-3, text message
  1.  .. S $P(MSA,FS,3)=$P(X,ECH(1),2)
  1.  . ; Reference Batch Control ID
  1.  . S:$P(HDR,FS,12)]"" ARY("HDR-12")=$P(HDR,FS,12)
  1.  ;
  1.  ; I $E(HDR,1,3)="MSH" D
  1.  I ARY("HDR-1")="MSH" D
  1.  . ;S ARY("DTM")=$P(HDR,FS,7),ARY("MID")=$P(HDR,FS,10),ARY("PID")=$P(HDR,FS,11),ARY("MTN")=$P($P(HDR,FS,9),$E(ECH)),ARY("ETN")=$P($P(HDR,FS,9),$E(ECH),2),ARY("VER")=$P(HDR,FS,12)
  1.  . S ARY("DTM")=$P(HDR,FS,7)
  1.  . S ARY("MID")=$P(HDR,FS,10)
  1.  . S ARY("PID")=$P(HDR,FS,11)
  1.  . S ARY("MTN")=$P($P(HDR,FS,9),ECH(1))
  1.  . S ARY("ETN")=$P($P(HDR,FS,9),ECH(1),2)
  1.  . S ARY("VER")=$P(HDR,FS,12)
  1.  . ;
  1.  . ; 2nd sub-component is Processing mode
  1.  . I ARY("PID")[ECH(1) D
  1.  .. S ARY("PMOD")=$P(ARY("PID"),ECH(1),2)
  1.  .. ; first sub-component is Processing id
  1.  .. S ARY("PID")=$P(ARY("PID"),ECH(1))
  1.  . ;
  1.  . ; S:$P($P(HDR,FS,9),$E(ECH),3)]"" ARY("MTN_ETN")=$P($P(HDR,FS,9),$E(ECH),3)
  1.  .I $P($P(HDR,FS,9),ECH(1),3)]"" D
  1.  .. S ARY("MTN_ETN")=$P($P(HDR,FS,9),ECH(1),3)
  1.  . ;
  1.  . ; fields 13 and 14
  1.  . S:$P(HDR,FS,13)]"" ARY("MSH-13")=$P(HDR,FS,13)
  1.  . S:$P(HDR,FS,14)]"" ARY("MSH-14")=$P(HDR,FS,14)
  1.  . ;
  1.  . ; S:$P(HDR,FS,15)]"" ARY("ACAT")=$P(HDR,FS,15) S:$P(HDR,FS,16)]"" ARY("APAT")=$P(HDR,FS,16) S:$P(HDR,FS,17)]"" ARY("CC")=$P(HDR,FS,17)
  1.  . S:$P(HDR,FS,15)]"" ARY("ACAT")=$P(HDR,FS,15)
  1.  . S:$P(HDR,FS,16)]"" ARY("APAT")=$P(HDR,FS,16)
  1.  . S:$P(HDR,FS,17)]"" ARY("CC")=$P(HDR,FS,17)
  1.  . ;
  1.  . ; fields 18,19,20 and 21
  1.  . S:$P(HDR,FS,18)]"" ARY("MSH-18")=$P(HDR,FS,18)
  1.  . S:$P(HDR,FS,19)]"" ARY("MSH-19")=$P(HDR,FS,19)
  1.  . S:$P(HDR,FS,20)]"" ARY("MSH-20")=$P(HDR,FS,20)
  1.  . S:$P(HDR,FS,21)]"" ARY("MSH-21")=$P(HDR,FS,21)
  1.  K:$G(MSA)']"" MSA
  1.  ;
  1.  S ARY("RAF")=$P(HDR,FS,6)  ; receiving facility
  1.  S ARY("SAF")=$P(HDR,FS,4)  ; sending facility
  1.  ;
  1.  ;Invoke continuation routine to perform remaining validation checks
  1.  D ^HLTPCK1A
  1.  ;
  1. EXIT ;
  1.  ; the maximum length of field #772,22 (Error Message) is 200
  1.  I ERR]"" D
  1.  . S ERR=$E(ERR,1,200)
  1.  . S ARY=$S('ERR:"13^"_ERR,1:ERR)
  1.  ; patch HL*1.6*120 end
  1.  Q