HLOAPI7 ;IRMFO-ALB/PIJ -API for retrieving HLO or HL7 information about a message;03/24/2004 14:43 ;06/04/2009
;;1.6;HEALTH LEVEL SEVEN;**146**;Oct 13, 1995;Build 16
;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
GETMSG(IEN,MSG,FLAG) ; Description: This function allows the user to toggle
;between HL7 and HLO messages and to return message information in a local array or a global.
;I '$G(FLAG) then MSG, IEN and file 778 are used for HLO messages.
;I $G(FLAG) then MSG, IEN and file 773 are used for HL7 messages.
;Input:
; IEN - The internal entry number of the message.
; MSG - The array name used to return the message information. Can be a local array or global.
; FLAG - I '$G(FLAG) use variables for HLO messages.
; FLAG - I $G(FLAG) use variables for HL7 messages.
;Output:
; Function returns 1 on success, 0 on failure. Failure would indicate that the
; message was not found or variable IEN or MSG was not passed
; MSG(0)= IEN (HL7 or HLO)
; HLO...
; MSG(1)= ^HLB(IEN,0)
; MSG(2)= ^HLB(IEN,1)
; MSG(3)= ^HLB(IEN,2)
; MSG(4)= ^HLB(IEN,3)
; MSG(5)= ^HLB(IEN,4)
; MSG(6)=""
; MSG(7)="^HLA(IEN,...
;
; HL7...
; Multiple MSG(1) = ^HLMA(IEN,"MSH",I,0)
; Multiple MSG(i)= ^HL(772,R772,"IN",I,0)
;
K DATA,@MSG
N CTR,DATA,I,N1,N2,N3,R772,R777,STAT
Q:'$G(IEN) 0
Q:'$D(MSG) 0
Q:MSG="FLAG" 0 ; may not need...
S (CTR,STAT)=1
I '$G(FLAG) Q:'$D(^HLB(IEN)) 0 D Q STAT
. ;HLO
. S N1=""
. F S N1=$O(^HLB(IEN,N1)) Q:N1="" D
. . I $D(^HLB(IEN,N1))=1 D
. . . S DATA=^HLB(IEN,N1)
. . . S:N1=0 R777=$P(DATA,U,2)
. . . S @MSG@(CTR)=DATA
. . . S CTR=CTR+1
. . I $D(^HLB(IEN,N1))=10 D ; this part is for Batch messages ^HLB(D0,3)
. . . S N2=""
. . . F S N2=$O(^HLB(IEN,N1,N2)) Q:N2="" D
. . . . F I=0:1:2 I $D(^HLB(IEN,N1,N2,I))=1 S @MSG@(CTR)=^HLB(IEN,N1,N2,I),CTR=CTR+1
. ; get Segments for HLO
. I 'R777 S STAT=0 Q
. S @MSG@(CTR)="",CTR=CTR+1 ; add blank line between message header and message body
. S (N1,N2,N3)=""
. F S N1=$O(^HLA(R777,N1)) Q:N1="" D
. . I $D(^HLA(R777,N1))=1 D
. . . S @MSG@(CTR)=^HLA(R777,N1)
. . . S CTR=CTR+1
. . I $D(^HLA(R777,N1))=10 D
. . . S N2=""
. . . F S N2=$O(^HLA(R777,N1,N2)) Q:N2="" D
. . . . I $D(^HLA(R777,N1,N2))=1 D
. . . . . S DATA=^HLA(R777,N1,N2)
. . . . . S @MSG@(CTR)=^HLA(R777,N1,N2),CTR=CTR+1
. . . . I $D(^HLA(R777,N1,N2,0))=1 D
. . . . . S DATA=^HLA(R777,N1,N2,0)
. . . . . S @MSG@(CTR)=^HLA(R777,N1,N2,0),CTR=CTR+1
. . . . S N3=""
. . . . F S N3=$O(^HLA(R777,N1,N2,1,N3)) Q:N3="" D
. . . . . I $D(^HLA(R777,N1,N2,1,N3,0))=1 D
. . . . . . S DATA=^HLA(R777,N1,N2,1,N3,0)
. . . . . . S @MSG@(CTR)=^HLA(R777,N1,N2,1,N3,0),CTR=CTR+1
;
;HL7
Q:'$D(^HLMA(IEN,0)) 0
S DATA=^HLMA(IEN,0) Q:'DATA 0 D
. S R772=$P(DATA,U,1)
. I 'R772 S STAT=0 Q
. ; get HL7 Message Header
. S N1=""
. F S N1=$O(^HLMA(IEN,N1)) Q:N1="" D
. . I $D(^HLMA(IEN,N1))=1 D
. . . S DATA=^HLMA(IEN,N1)
. . . S @MSG@(CTR)=DATA
. . . S CTR=CTR+1
. . S N2=""
. . F S N2=$O(^HLMA(IEN,N1,N2)) Q:N2="" D
. . . I $D(^HLMA(IEN,N1,N2))=1 D
. . . . S DATA=^HLMA(IEN,N1,N2)
. . . . S @MSG@(CTR)=DATA
. . . . S CTR=CTR+1
. . . S N3=""
. . . F S N3=$O(^HLMA(IEN,N1,N2,N3)) Q:N3="" D
. . . . I $D(^HLMA(IEN,N1,N2,N3))=1 D
. . . . . S DATA=^HLMA(IEN,N1,N2,N3)
. . . . . S @MSG@(CTR)=DATA
. . . . . S CTR=CTR+1
. ; get HL7 Message Body
. S @MSG@(CTR)="",CTR=CTR+1 ; add blank line between message header and message body
. S N1=""
. F S N1=$O(^HL(772,R772,N1)) Q:N1="" D
. . I $D(^HL(772,R772,N1))=1 D
. . . S DATA=^HL(772,R772,N1)
. . . S @MSG@(CTR)=DATA
. . . S CTR=CTR+1
. . S N2=""
. . F S N2=$O(^HL(772,R772,N1,N2)) Q:N2="" D
. . . I $D(^HL(772,R772,N1,N2))=1 D
. . . . S DATA=^HL(772,R772,N1,N2)
. . . . S @MSG@(CTR)=DATA
. . . . S CTR=CTR+1
. . . S N3=""
. . . F S N3=$O(^HL(772,R772,N1,N2,N3)) Q:N3="" D
. . . . I $D(^HL(772,R772,N1,N2,N3))=1 D
. . . . . S DATA=^HL(772,R772,N1,N2,N3)
. . . . . S @MSG@(CTR)=DATA
. . . . . S CTR=CTR+1
Q STAT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOAPI7 4146 printed May 06, 2022@00:45:45 Page 2
HLOAPI7 ;IRMFO-ALB/PIJ -API for retrieving HLO or HL7 information about a message;03/24/2004 14:43 ;06/04/2009
+1 ;;1.6;HEALTH LEVEL SEVEN;**146**;Oct 13, 1995;Build 16
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
GETMSG(IEN,MSG,FLAG) ; Description: This function allows the user to toggle
+1 ;between HL7 and HLO messages and to return message information in a local array or a global.
+2 ;I '$G(FLAG) then MSG, IEN and file 778 are used for HLO messages.
+3 ;I $G(FLAG) then MSG, IEN and file 773 are used for HL7 messages.
+4 ;Input:
+5 ; IEN - The internal entry number of the message.
+6 ; MSG - The array name used to return the message information. Can be a local array or global.
+7 ; FLAG - I '$G(FLAG) use variables for HLO messages.
+8 ; FLAG - I $G(FLAG) use variables for HL7 messages.
+9 ;Output:
+10 ; Function returns 1 on success, 0 on failure. Failure would indicate that the
+11 ; message was not found or variable IEN or MSG was not passed
+12 ; MSG(0)= IEN (HL7 or HLO)
+13 ; HLO...
+14 ; MSG(1)= ^HLB(IEN,0)
+15 ; MSG(2)= ^HLB(IEN,1)
+16 ; MSG(3)= ^HLB(IEN,2)
+17 ; MSG(4)= ^HLB(IEN,3)
+18 ; MSG(5)= ^HLB(IEN,4)
+19 ; MSG(6)=""
+20 ; MSG(7)="^HLA(IEN,...
+21 ;
+22 ; HL7...
+23 ; Multiple MSG(1) = ^HLMA(IEN,"MSH",I,0)
+24 ; Multiple MSG(i)= ^HL(772,R772,"IN",I,0)
+25 ;
+26 KILL DATA,@MSG
+27 NEW CTR,DATA,I,N1,N2,N3,R772,R777,STAT
+28 if '$GET(IEN)
QUIT 0
+29 if '$DATA(MSG)
QUIT 0
+30 ; may not need...
if MSG="FLAG"
QUIT 0
+31 SET (CTR,STAT)=1
+32 IF '$GET(FLAG)
if '$DATA(^HLB(IEN))
QUIT 0
Begin DoDot:1
+33 ;HLO
+34 SET N1=""
+35 FOR
SET N1=$ORDER(^HLB(IEN,N1))
if N1=""
QUIT
Begin DoDot:2
+36 IF $DATA(^HLB(IEN,N1))=1
Begin DoDot:3
+37 SET DATA=^HLB(IEN,N1)
+38 if N1=0
SET R777=$PIECE(DATA,U,2)
+39 SET @MSG@(CTR)=DATA
+40 SET CTR=CTR+1
End DoDot:3
+41 ; this part is for Batch messages ^HLB(D0,3)
IF $DATA(^HLB(IEN,N1))=10
Begin DoDot:3
+42 SET N2=""
+43 FOR
SET N2=$ORDER(^HLB(IEN,N1,N2))
if N2=""
QUIT
Begin DoDot:4
+44 FOR I=0:1:2
IF $DATA(^HLB(IEN,N1,N2,I))=1
SET @MSG@(CTR)=^HLB(IEN,N1,N2,I)
SET CTR=CTR+1
End DoDot:4
End DoDot:3
End DoDot:2
+45 ; get Segments for HLO
+46 IF 'R777
SET STAT=0
QUIT
+47 ; add blank line between message header and message body
SET @MSG@(CTR)=""
SET CTR=CTR+1
+48 SET (N1,N2,N3)=""
+49 FOR
SET N1=$ORDER(^HLA(R777,N1))
if N1=""
QUIT
Begin DoDot:2
+50 IF $DATA(^HLA(R777,N1))=1
Begin DoDot:3
+51 SET @MSG@(CTR)=^HLA(R777,N1)
+52 SET CTR=CTR+1
End DoDot:3
+53 IF $DATA(^HLA(R777,N1))=10
Begin DoDot:3
+54 SET N2=""
+55 FOR
SET N2=$ORDER(^HLA(R777,N1,N2))
if N2=""
QUIT
Begin DoDot:4
+56 IF $DATA(^HLA(R777,N1,N2))=1
Begin DoDot:5
+57 SET DATA=^HLA(R777,N1,N2)
+58 SET @MSG@(CTR)=^HLA(R777,N1,N2)
SET CTR=CTR+1
End DoDot:5
+59 IF $DATA(^HLA(R777,N1,N2,0))=1
Begin DoDot:5
+60 SET DATA=^HLA(R777,N1,N2,0)
+61 SET @MSG@(CTR)=^HLA(R777,N1,N2,0)
SET CTR=CTR+1
End DoDot:5
+62 SET N3=""
+63 FOR
SET N3=$ORDER(^HLA(R777,N1,N2,1,N3))
if N3=""
QUIT
Begin DoDot:5
+64 IF $DATA(^HLA(R777,N1,N2,1,N3,0))=1
Begin DoDot:6
+65 SET DATA=^HLA(R777,N1,N2,1,N3,0)
+66 SET @MSG@(CTR)=^HLA(R777,N1,N2,1,N3,0)
SET CTR=CTR+1
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
QUIT STAT
+67 ;
+68 ;HL7
+69 if '$DATA(^HLMA(IEN,0))
QUIT 0
+70 SET DATA=^HLMA(IEN,0)
if 'DATA
QUIT 0
Begin DoDot:1
+71 SET R772=$PIECE(DATA,U,1)
+72 IF 'R772
SET STAT=0
QUIT
+73 ; get HL7 Message Header
+74 SET N1=""
+75 FOR
SET N1=$ORDER(^HLMA(IEN,N1))
if N1=""
QUIT
Begin DoDot:2
+76 IF $DATA(^HLMA(IEN,N1))=1
Begin DoDot:3
+77 SET DATA=^HLMA(IEN,N1)
+78 SET @MSG@(CTR)=DATA
+79 SET CTR=CTR+1
End DoDot:3
+80 SET N2=""
+81 FOR
SET N2=$ORDER(^HLMA(IEN,N1,N2))
if N2=""
QUIT
Begin DoDot:3
+82 IF $DATA(^HLMA(IEN,N1,N2))=1
Begin DoDot:4
+83 SET DATA=^HLMA(IEN,N1,N2)
+84 SET @MSG@(CTR)=DATA
+85 SET CTR=CTR+1
End DoDot:4
+86 SET N3=""
+87 FOR
SET N3=$ORDER(^HLMA(IEN,N1,N2,N3))
if N3=""
QUIT
Begin DoDot:4
+88 IF $DATA(^HLMA(IEN,N1,N2,N3))=1
Begin DoDot:5
+89 SET DATA=^HLMA(IEN,N1,N2,N3)
+90 SET @MSG@(CTR)=DATA
+91 SET CTR=CTR+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+92 ; get HL7 Message Body
+93 ; add blank line between message header and message body
SET @MSG@(CTR)=""
SET CTR=CTR+1
+94 SET N1=""
+95 FOR
SET N1=$ORDER(^HL(772,R772,N1))
if N1=""
QUIT
Begin DoDot:2
+96 IF $DATA(^HL(772,R772,N1))=1
Begin DoDot:3
+97 SET DATA=^HL(772,R772,N1)
+98 SET @MSG@(CTR)=DATA
+99 SET CTR=CTR+1
End DoDot:3
+100 SET N2=""
+101 FOR
SET N2=$ORDER(^HL(772,R772,N1,N2))
if N2=""
QUIT
Begin DoDot:3
+102 IF $DATA(^HL(772,R772,N1,N2))=1
Begin DoDot:4
+103 SET DATA=^HL(772,R772,N1,N2)
+104 SET @MSG@(CTR)=DATA
+105 SET CTR=CTR+1
End DoDot:4
+106 SET N3=""
+107 FOR
SET N3=$ORDER(^HL(772,R772,N1,N2,N3))
if N3=""
QUIT
Begin DoDot:4
+108 IF $DATA(^HL(772,R772,N1,N2,N3))=1
Begin DoDot:5
+109 SET DATA=^HL(772,R772,N1,N2,N3)
+110 SET @MSG@(CTR)=DATA
+111 SET CTR=CTR+1
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+112 QUIT STAT
