- 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 Jan 18, 2025@02:59:46 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