- HLFNC2 ;AISC/SAW-Continuation of HLFNC, Additional Functions/Calls Used for HL7 Messages ;12/17/2002 16:40
- ;;1.6;HEALTH LEVEL SEVEN;**2,26,57,59,101**;Oct 13, 1995
- INIT(EID,HL,INT) ;Initialize Variables in HL array for Building a Message
- ;
- ;This is a subroutine call with parameter passing that returns an
- ;array of values in the variable specified by the parameter HL. If no
- ;error occurs, the array of values is returned. Otherwise, the single
- ;value HL is returned equal to the following: error code^error message
- ;
- ;Required Input Parameters
- ; EID = Name or IEN of the event driver or subscriber protocol in
- ; Protocol file for which the initialization variables are
- ; to be returned
- ; HL = The variable in which the array of values will be returned
- ; This parameter must be passed by reference
- ;Optional Input Parameter
- ; INT = 1 indicates that only array values for internal DHCP
- ; to DHCP message exchange should be initialized
- ;
- ;Check for required input parameter
- I $G(EID)="" S HL="7^Missing EID Input Parameter" Q
- I '$D(INT) S INT=0
- ;Convert EID to IEN if necessary
- I 'EID S EID=$O(^ORD(101,"B",EID,0)) I 'EID S HL="1^"_$G(^HL(771.7,1,0)) Q
- N X0,X,X1,X2
- ;Get node 770 from file 101 and node 0 from file 771
- S X0=$G(^ORD(101,EID,0))
- ;if server application is disabled quit
- I $P(X0,U,3)]"" S HL="16^"_$G(^HL(771.7,16,0)) Q
- ;if no known clients, set error but allow app to continue
- I '$D(^ORD(101,EID,775,"B")) S HL="15^"_$G(^HL(771.7,15,0))
- S X=$G(^ORD(101,EID,770)),X1=$G(^HL(771,+X,0))
- I X1']"" S HL="14^"_$G(^HL(771.7,14,0)) Q
- ;Set HL array variables
- S HL("Q")="""""",HL("FS")=$G(^HL(771,+X,"FS")),HL("ECH")=$G(^("EC")) S:HL("FS")']"" HL("FS")="^" S:HL("ECH")']"" HL("ECH")="~|\&"
- S HL("SAN")=$P(X1,"^"),HL("SAF")=$P(X1,"^",3) S:$P(X1,"^",7) HL("CC")=$P($G(^HL(779.004,$P(X1,"^",7),0)),"^")
- S HL("MTN")=$P($G(^HL(771.2,+$P(X,"^",3),0)),"^"),HL("ETN")=$P($G(^HL(779.001,+$P(X,"^",4),0)),"^")
- S:$P(X,"^",5) HL("MTN_ETN")=$P($G(^HL(779.005,+$P(X,"^",5),0)),"^")
- S HL("PID")=$S($P(X,"^",6)="D":"D",1:$P($$PARAM^HLCS2,"^",3)),HL("VER")=$P($G(^HL(771.5,+$P(X,"^",10),0)),"^")
- S:$P(X,"^",9) HL("APAT")=$P($G(^HL(779.003,$P(X,"^",9),0)),"^")
- I 'INT S:$P(X,"^",8) HL("ACAT")=$P($G(^HL(779.003,$P(X,"^",8),0)),"^")
- ;-- Set variables for backwards compatablity
- S HLQ=HL("Q"),HLFS=HL("FS"),HLECH=HL("ECH")
- Q
- MSH(HL,MID,RESULT,SECURITY) ;Create an MSH Segment for an Outgoing HL7
- ;Message
- ;
- ;This is a subroutine call with parameter passing that returns an HL7
- ;Message Header (MSH) segment in the variable RESULT (and possibly
- ;RESULT(1) if the MSH segment is longer than 245 characters). If the
- ;required input parameters HL or MID are missing, RESULT is returned
- ;equal to null
- ;
- ;Required Input Parameters
- ; HL = The array of values returned by the call to INIT^HLFNC2
- ; MID = The Message Control ID to be included in the MSH segment.
- ; The Batch Control ID for the batch is returned by the
- ; call to CREATE^HLTF. The application concatenates a
- ; sequential number to the batch ID to create the MID
- ; RESULT = The variable that will be returned to the calling
- ; application as described above
- ;Optional Input Parameter
- ;SECURITY = Security to be included in field #8 of the MSH segment
- ;
- ;Check for required parameters
- I '$D(HL)#2!('$D(MID)) Q ""
- N X,X1,X2
- ;Build MSH segment from HL array variables and other input parameters
- S X="MSH"_HL("FS")_HL("ECH")_HL("FS")_HL("SAN")_HL("FS")_HL("SAF")_HL("FS")_$S($D(HL("RAN")):HL("RAN"),1:"")_HL("FS")_$S($D(HL("RAF")):HL("RAF"),1:"")_HL("FS")_$S($D(HL("DTM")):HL("DTM"),1:"")_HL("FS")
- S X=X_$S($G(SECURITY)]"":SECURITY,1:"")_HL("FS")_HL("MTN")_$E(HL("ECH"))_HL("ETN")
- ;Message structure component for HL7 v 2.3.1 and beyond
- S:$D(HL("MTN_ETN")) X=X_$E(HL("ECH"))_HL("MTN_ETN")
- S X=X_HL("FS")_MID_HL("FS")_HL("PID")_HL("FS")_HL("VER")
- S:$D(HL("SN")) $P(X,HL("FS"),13)=HL("SN") S:$D(HL("ACAT")) $P(X,HL("FS"),15)=HL("ACAT") S:$D(HL("APAT")) $P(X,HL("FS"),16)=HL("APAT") S:$D(HL("CC")) $P(X,HL("FS"),17)=HL("CC")
- ;If continuation pointer variable exists, insert it in piece 14 and
- ;create new variable X1 if length of X will be greater than 245
- I $D(HL("CP")) D
- .I $L(X)+$L(HL("CP"))+2'>245 S $P(X,HL("FS"),14)=HL("CP") Q
- .S $P(X,HL("FS"),14)="",X1=HL("FS")_$P(X,HL("FS"),15,17),X=$P(X,HL("FS"),1,14)
- .S X2=$L(X),X=X_$E(HL("CP"),1,(245-X2)),X1=$E(HL("CP"),(246-X2),245)_X1
- .S X2=$L(X) I $L(X2)<245 S X=X_$E(X1,1,(245-X2)),X1=$E(X1,(246-X2),245)
- S RESULT=X S:$L($G(X1)) RESULT(1)=X1
- Q
- RSPINIT(EIDS,HL) ;Initialize Variables in HL array for Building a Response Message
- ;
- ;This is a subroutine call with parameter passing that returns an
- ;array of values in the variable specified by the parameter HL. If no
- ;error occurs, the array of values is returned. Otherwise, the single
- ;value HL is returned equal to the following: error code^error message
- ;
- ;Required Input Parameters
- ; EIDS = Name or IEN of the subscriber protocol in
- ; Protocol file for which the initialization variables are
- ; to be returned
- ; HL = The variable in which the array of values will be returned
- ; This parameter must be passed by reference
- ;
- ;Check for required input parameter
- I $G(EIDS)="" S HL="7^Missing EIDS Input Parameter" Q
- ;Convert EIDS to IEN if necessary
- I 'EIDS S EIDS=$O(^ORD(101,"B",EIDS,0)) I 'EIDS S HL="15^"_"Invalid Subscriber Protocol" Q
- N X0,X,X1,X2
- ;Get node 770 from file 101 and node 0 from file 771
- S X0=$G(^ORD(101,EIDS,0))
- S X=$G(^ORD(101,EIDS,770)),X1=$G(^HL(771,+$P(X,"^",2),0))
- I X1']"" S HL="15^"_"Subscriber Application Missing in Protocol File" Q
- ;Set HL array variables
- S HL("RFS")=$G(^HL(771,+$P(X,"^",2),"FS")),HL("RECH")=$G(^("EC")) S:HL("RFS")']"" HL("RFS")="^" S:HL("RECH")']"" HL("RECH")="~|\&"
- S HL("RAN")=$P(X1,"^")
- S HL("RMTN")=$P($G(^HL(771.2,+$P(X,"^",11),0)),"^"),HL("RETN")=$P($G(^HL(779.001,+$P(X,"^",4),0)),"^")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLFNC2 6157 printed Jan 18, 2025@02:59:26 Page 2
- HLFNC2 ;AISC/SAW-Continuation of HLFNC, Additional Functions/Calls Used for HL7 Messages ;12/17/2002 16:40
- +1 ;;1.6;HEALTH LEVEL SEVEN;**2,26,57,59,101**;Oct 13, 1995
- INIT(EID,HL,INT) ;Initialize Variables in HL array for Building a Message
- +1 ;
- +2 ;This is a subroutine call with parameter passing that returns an
- +3 ;array of values in the variable specified by the parameter HL. If no
- +4 ;error occurs, the array of values is returned. Otherwise, the single
- +5 ;value HL is returned equal to the following: error code^error message
- +6 ;
- +7 ;Required Input Parameters
- +8 ; EID = Name or IEN of the event driver or subscriber protocol in
- +9 ; Protocol file for which the initialization variables are
- +10 ; to be returned
- +11 ; HL = The variable in which the array of values will be returned
- +12 ; This parameter must be passed by reference
- +13 ;Optional Input Parameter
- +14 ; INT = 1 indicates that only array values for internal DHCP
- +15 ; to DHCP message exchange should be initialized
- +16 ;
- +17 ;Check for required input parameter
- +18 IF $GET(EID)=""
- SET HL="7^Missing EID Input Parameter"
- QUIT
- +19 IF '$DATA(INT)
- SET INT=0
- +20 ;Convert EID to IEN if necessary
- +21 IF 'EID
- SET EID=$ORDER(^ORD(101,"B",EID,0))
- IF 'EID
- SET HL="1^"_$GET(^HL(771.7,1,0))
- QUIT
- +22 NEW X0,X,X1,X2
- +23 ;Get node 770 from file 101 and node 0 from file 771
- +24 SET X0=$GET(^ORD(101,EID,0))
- +25 ;if server application is disabled quit
- +26 IF $PIECE(X0,U,3)]""
- SET HL="16^"_$GET(^HL(771.7,16,0))
- QUIT
- +27 ;if no known clients, set error but allow app to continue
- +28 IF '$DATA(^ORD(101,EID,775,"B"))
- SET HL="15^"_$GET(^HL(771.7,15,0))
- +29 SET X=$GET(^ORD(101,EID,770))
- SET X1=$GET(^HL(771,+X,0))
- +30 IF X1']""
- SET HL="14^"_$GET(^HL(771.7,14,0))
- QUIT
- +31 ;Set HL array variables
- +32 SET HL("Q")=""""""
- SET HL("FS")=$GET(^HL(771,+X,"FS"))
- SET HL("ECH")=$GET(^("EC"))
- if HL("FS")']""
- SET HL("FS")="^"
- if HL("ECH")']""
- SET HL("ECH")="~|\&"
- +33 SET HL("SAN")=$PIECE(X1,"^")
- SET HL("SAF")=$PIECE(X1,"^",3)
- if $PIECE(X1,"^",7)
- SET HL("CC")=$PIECE($GET(^HL(779.004,$PIECE(X1,"^",7),0)),"^")
- +34 SET HL("MTN")=$PIECE($GET(^HL(771.2,+$PIECE(X,"^",3),0)),"^")
- SET HL("ETN")=$PIECE($GET(^HL(779.001,+$PIECE(X,"^",4),0)),"^")
- +35 if $PIECE(X,"^",5)
- SET HL("MTN_ETN")=$PIECE($GET(^HL(779.005,+$PIECE(X,"^",5),0)),"^")
- +36 SET HL("PID")=$SELECT($PIECE(X,"^",6)="D":"D",1:$PIECE($$PARAM^HLCS2,"^",3))
- SET HL("VER")=$PIECE($GET(^HL(771.5,+$PIECE(X,"^",10),0)),"^")
- +37 if $PIECE(X,"^",9)
- SET HL("APAT")=$PIECE($GET(^HL(779.003,$PIECE(X,"^",9),0)),"^")
- +38 IF 'INT
- if $PIECE(X,"^",8)
- SET HL("ACAT")=$PIECE($GET(^HL(779.003,$PIECE(X,"^",8),0)),"^")
- +39 ;-- Set variables for backwards compatablity
- +40 SET HLQ=HL("Q")
- SET HLFS=HL("FS")
- SET HLECH=HL("ECH")
- +41 QUIT
- MSH(HL,MID,RESULT,SECURITY) ;Create an MSH Segment for an Outgoing HL7
- +1 ;Message
- +2 ;
- +3 ;This is a subroutine call with parameter passing that returns an HL7
- +4 ;Message Header (MSH) segment in the variable RESULT (and possibly
- +5 ;RESULT(1) if the MSH segment is longer than 245 characters). If the
- +6 ;required input parameters HL or MID are missing, RESULT is returned
- +7 ;equal to null
- +8 ;
- +9 ;Required Input Parameters
- +10 ; HL = The array of values returned by the call to INIT^HLFNC2
- +11 ; MID = The Message Control ID to be included in the MSH segment.
- +12 ; The Batch Control ID for the batch is returned by the
- +13 ; call to CREATE^HLTF. The application concatenates a
- +14 ; sequential number to the batch ID to create the MID
- +15 ; RESULT = The variable that will be returned to the calling
- +16 ; application as described above
- +17 ;Optional Input Parameter
- +18 ;SECURITY = Security to be included in field #8 of the MSH segment
- +19 ;
- +20 ;Check for required parameters
- +21 IF '$DATA(HL)#2!('$DATA(MID))
- QUIT ""
- +22 NEW X,X1,X2
- +23 ;Build MSH segment from HL array variables and other input parameters
- +24 SET X="MSH"_HL("FS")_HL("ECH")_HL("FS")_HL("SAN")_HL("FS")_HL("SAF")_HL("FS")_$SELECT($DATA(HL("RAN")):HL("RAN"),1:"")_HL("FS")_$SELECT($DATA(HL("RAF")):HL("RAF"),1:"")_HL("FS")_$SELECT($DATA(HL("DTM")):HL("DTM"),1:"")_HL("FS")
- +25 SET X=X_$SELECT($GET(SECURITY)]"":SECURITY,1:"")_HL("FS")_HL("MTN")_$EXTRACT(HL("ECH"))_HL("ETN")
- +26 ;Message structure component for HL7 v 2.3.1 and beyond
- +27 if $DATA(HL("MTN_ETN"))
- SET X=X_$EXTRACT(HL("ECH"))_HL("MTN_ETN")
- +28 SET X=X_HL("FS")_MID_HL("FS")_HL("PID")_HL("FS")_HL("VER")
- +29 if $DATA(HL("SN"))
- SET $PIECE(X,HL("FS"),13)=HL("SN")
- if $DATA(HL("ACAT"))
- SET $PIECE(X,HL("FS"),15)=HL("ACAT")
- if $DATA(HL("APAT"))
- SET $PIECE(X,HL("FS"),16)=HL("APAT")
- if $DATA(HL("CC"))
- SET $PIECE(X,HL("FS"),17)=HL("CC")
- +30 ;If continuation pointer variable exists, insert it in piece 14 and
- +31 ;create new variable X1 if length of X will be greater than 245
- +32 IF $DATA(HL("CP"))
- Begin DoDot:1
- +33 IF $LENGTH(X)+$LENGTH(HL("CP"))+2'>245
- SET $PIECE(X,HL("FS"),14)=HL("CP")
- QUIT
- +34 SET $PIECE(X,HL("FS"),14)=""
- SET X1=HL("FS")_$PIECE(X,HL("FS"),15,17)
- SET X=$PIECE(X,HL("FS"),1,14)
- +35 SET X2=$LENGTH(X)
- SET X=X_$EXTRACT(HL("CP"),1,(245-X2))
- SET X1=$EXTRACT(HL("CP"),(246-X2),245)_X1
- +36 SET X2=$LENGTH(X)
- IF $LENGTH(X2)<245
- SET X=X_$EXTRACT(X1,1,(245-X2))
- SET X1=$EXTRACT(X1,(246-X2),245)
- End DoDot:1
- +37 SET RESULT=X
- if $LENGTH($GET(X1))
- SET RESULT(1)=X1
- +38 QUIT
- RSPINIT(EIDS,HL) ;Initialize Variables in HL array for Building a Response Message
- +1 ;
- +2 ;This is a subroutine call with parameter passing that returns an
- +3 ;array of values in the variable specified by the parameter HL. If no
- +4 ;error occurs, the array of values is returned. Otherwise, the single
- +5 ;value HL is returned equal to the following: error code^error message
- +6 ;
- +7 ;Required Input Parameters
- +8 ; EIDS = Name or IEN of the subscriber protocol in
- +9 ; Protocol file for which the initialization variables are
- +10 ; to be returned
- +11 ; HL = The variable in which the array of values will be returned
- +12 ; This parameter must be passed by reference
- +13 ;
- +14 ;Check for required input parameter
- +15 IF $GET(EIDS)=""
- SET HL="7^Missing EIDS Input Parameter"
- QUIT
- +16 ;Convert EIDS to IEN if necessary
- +17 IF 'EIDS
- SET EIDS=$ORDER(^ORD(101,"B",EIDS,0))
- IF 'EIDS
- SET HL="15^"_"Invalid Subscriber Protocol"
- QUIT
- +18 NEW X0,X,X1,X2
- +19 ;Get node 770 from file 101 and node 0 from file 771
- +20 SET X0=$GET(^ORD(101,EIDS,0))
- +21 SET X=$GET(^ORD(101,EIDS,770))
- SET X1=$GET(^HL(771,+$PIECE(X,"^",2),0))
- +22 IF X1']""
- SET HL="15^"_"Subscriber Application Missing in Protocol File"
- QUIT
- +23 ;Set HL array variables
- +24 SET HL("RFS")=$GET(^HL(771,+$PIECE(X,"^",2),"FS"))
- SET HL("RECH")=$GET(^("EC"))
- if HL("RFS")']""
- SET HL("RFS")="^"
- if HL("RECH")']""
- SET HL("RECH")="~|\&"
- +25 SET HL("RAN")=$PIECE(X1,"^")
- +26 SET HL("RMTN")=$PIECE($GET(^HL(771.2,+$PIECE(X,"^",11),0)),"^")
- SET HL("RETN")=$PIECE($GET(^HL(779.001,+$PIECE(X,"^",4),0)),"^")
- +27 QUIT