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

HLTPCK2.m

Go to the documentation of this file.
  1. HLTPCK2 ;SF/RSD - Message Header Validation (TCP Link) ;09/13/2006
  1. ;;1.6;HEALTH LEVEL SEVEN;**19,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) ;
  1. ;Validate Data in Header Segment (MSH, BHS or FHS) of an HL7 Message
  1. ; through 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. ;The message header can be multiple line longer than 255 characters.
  1. ;HDR is an array that is passed by reference.
  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 array, HDR(1,0)=segment (passed by reference)
  1. ;
  1. ; ARY = The array in which the message header values will be
  1. ; returned (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. Passed
  1. ; by reference so that Batch msg. can set this here.
  1. ;
  1. ;Check for required parameters
  1. N ERR S ERR=""
  1. I $D(HDR)<10 S ERR="7^"_$G(^HL(771.7,7,0))_" at CHK^HLTPCK2" 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(1,0),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,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. M ARY("HDR")=HDR
  1. ;
  1. ;Validate Message Header Type
  1. S (ARY("TYPE"),X)=$$P(.HDR,1)
  1. S ARY("HDR-1")=X
  1. I X=""!("FHS,BHS,MSH"'[X) S ERR="Invalid Message Header" G EXIT
  1. ;
  1. ;Extract data from message header segment
  1. ; S ARY("SAN")=$$P(.HDR,3),ARY("SFN")=$$P(.HDR,4),ARY("RAN")=$$P(.HDR,5),ARY("RFN")=$$P(.HDR,6),ARY("DTM")=$$P(.HDR,7)
  1. S ARY("SAN")=$$P(.HDR,3)
  1. S ARY("SFN")=$$P(.HDR,4)
  1. S ARY("RAN")=$$P(.HDR,5)
  1. S ARY("RFN")=$$P(.HDR,6)
  1. S ARY("DTM")=$$P(.HDR,7)
  1. ;
  1. I X="BHS"!(X="FHS") D
  1. . ; S ARY("MID")=$$P(.HDR,11),X=$$P(.HDR,9),ARY("PID")=$P(X,$E(ECH),2)
  1. . ;
  1. . S ARY("MID")=$$P(.HDR,11)
  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 ID
  1. . ; 5th component: Accept Acknowledgment Type
  1. . ; 6th component: Application Acknowledgment Type
  1. . S X=$$P(.HDR,9)
  1. . S:X]"" 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($P(X,$E(ECH),3),$E(ECH,2)),ARY("ETN")=$P($P(X,$E(ECH),3),$E(ECH,2),2)
  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")=""
  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,$E(ECH),4),ARY("ACAT")=$P(X,$E(ECH),5),ARY("APAT")=$P(X,$E(ECH),6)
  1. . S ARY("VER")=$P(X,ECH(1),4)
  1. . S:$P(X,ECH(1),5)]"" ARY("ACAT")=$P(X,ECH(1),5)
  1. . S:$P(X,ECH(1),6)]"" ARY("APAT")=$P(X,ECH(1),6)
  1. . ;
  1. . ; BHS-10, batch comment
  1. . ; first component: MSA-1, acknowledgment code
  1. . ; 2nd component: MSA-3, text message
  1. . ; S:$$P(.HDR,10)]"" MSA=$P($$P(.HDR,10),$E(ECH),1),$P(MSA,FS,2)=$$P(.HDR,12),$P(MSA,FS,3)=$P($$P(.HDR,10),$E(ECH),2)
  1. . ;
  1. . S X=$$P(.HDR,10)
  1. . I X]"" D
  1. .. S ARY("HDR-10")=X
  1. .. ; MSA-1, acknowledgment code: AA,AE,AR,CA,CE,or 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,12)
  1. .. ; MSA-3, text message
  1. .. S $P(MSA,FS,3)=$P(X,ECH(1),2)
  1. . ;
  1. . ; Reference Batch Control ID
  1. . S:$$P(.HDR,12)]"" ARY("HDR-12")=$$P(.HDR,12)
  1. ;
  1. ; I $$P(.HDR,1)="MSH" D
  1. I ARY("HDR-1")="MSH" D
  1. . ; S ARY("MID")=$$P(.HDR,10),ARY("PID")=$$P(.HDR,11),ARY("MTN")=$P($$P(.HDR,9),$E(ECH)),ARY("ETN")=$P($$P(.HDR,9),$E(ECH),2),ARY("VER")=$$P(.HDR,12)
  1. . S ARY("MID")=$$P(.HDR,10)
  1. . S ARY("PID")=$$P(.HDR,11)
  1. . S X=$$P(.HDR,9)
  1. . S ARY("MTN")=$P(X,ECH(1))
  1. . S ARY("ETN")=$P(X,ECH(1),2)
  1. . ;
  1. . ; S:$P($$P(.HDR,9),$E(ECH),3)'="" ARY("MTN_ETN")=$P($$P(.HDR,9),$E(ECH),3)
  1. . S:$P(X,ECH(1),3)]"" ARY("MTN_ETN")=$P(X,ECH(1),3)
  1. . ;
  1. . I ARY("PID")[ECH(1) D
  1. .. ; 2nd component is Processing mode
  1. .. S ARY("PMOD")=$P(ARY("PID"),ECH(1),2)
  1. .. ; first component is Processing id
  1. .. S ARY("PID")=$P(ARY("PID"),ECH(1))
  1. . ;
  1. . S ARY("VER")=$$P(.HDR,12)
  1. . ;
  1. . ; fields 13 and 14
  1. . S:$$P(.HDR,13)]"" ARY("MSH-13")=$$P(.HDR,13)
  1. . S:$$P(.HDR,14)]"" ARY("MSH-14")=$$P(.HDR,14)
  1. . ;
  1. . ; S:$$P(.HDR,15)]"" ARY("ACAT")=$$P(.HDR,15) S:$$P(.HDR,16)]"" ARY("APAT")=$$P(.HDR,16) S:$$P(.HDR,17)]"" ARY("CC")=$$P(.HDR,17)
  1. . S:$$P(.HDR,15)]"" ARY("ACAT")=$$P(.HDR,15)
  1. . S:$$P(.HDR,16)]"" ARY("APAT")=$$P(.HDR,16)
  1. . S:$$P(.HDR,17)]"" ARY("CC")=$$P(.HDR,17)
  1. . ;
  1. . ; fields 18,19,20 and 21
  1. . S:$$P(.HDR,18)]"" ARY("MSH-18")=$$P(.HDR,18)
  1. . S:$$P(.HDR,19)]"" ARY("MSH-19")=$$P(.HDR,19)
  1. . S:$$P(.HDR,20)]"" ARY("MSH-20")=$$P(.HDR,20)
  1. . S:$$P(.HDR,21)]"" ARY("MSH-21")=$$P(.HDR,21)
  1. ;
  1. ;Invoke continuation routine to perform remaining validation checks
  1. D ^HLTPCK2A
  1. EXIT ;
  1. ; patch HL*1.6*120
  1. ; the maximum length of field #773,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
  1. ;
  1. P(MSH,P) ;get piece P from MSH array (passed by ref.)
  1. N FS,I,L,L1,L2,X,Y
  1. S FS=$E(MSH(1,0),4),(L2,Y)=0,X=""
  1. F I=1:1 S L1=$L($G(MSH(I,0)),FS),L=L1+Y-1 D Q:$L(X)!'$D(MSH(I,0))
  1. . S:L1=1 L=L+1
  1. . S:P'>L X=$P($G(MSH(I-1,0)),FS,P-L2)_$P($G(MSH(I,0)),FS,(P-Y))
  1. . S L2=Y,Y=L
  1. Q X
  1. ;