HLOMSG1 ;ALB/CJM-HL7 - APIs for files 777/778 (CONTINUED) ;06/19/2009
;;1.6;HEALTH LEVEL SEVEN;**126,143**;Oct 13, 1995;Build 3
;
FINDMSG(MSGID,LIST) ;
;Given a message id, this function finds the file 778 entries having that message id. The count is returned as the function value. If the message
;is within a batch, it might be in the subfile. The list of found
;records is in the format LIST(1)=<IEN>^<SUBIEN>,LIST(2)=<IEN>^<SUBIEN>,
;etc., where SUBIEN="" if the message is not within a batch.
;
N COUNT,MSG
K LIST
Q:$G(MSGID)="" 0
S (MSG,COUNT)=0
F S MSG=$O(^HLB("B",MSGID,MSG)) Q:'MSG S COUNT=COUNT+1,LIST(COUNT)=MSG
S MSG=""
F S MSG=$O(^HLB("AE",MSGID,MSG)) Q:MSG="" S COUNT=COUNT+1,LIST(COUNT)=MSG
Q COUNT
;
ACKTOIEN(MSGID,ACKTO) ;
;finds the ien of the initial message
;Input:
; MSGID - the msg id of the ack message
; ACKTO - msgid of the original message
;Output: Function returns "" if not found, otherwise the IEN, or, if the message is in a batch, the <ien>^<subien>
;
N LIST,RETURN,COUNT,IEN,SUBIEN
S RETURN=""
;
;**P146 START CJM
I $P(ACKTO," "),$P(ACKTO," ")=$P($G(^HLD(779.1,1,0)),"^",2) D
.I '(ACKTO["-") D
..S IEN=$P(ACKTO," ",2)
..I IEN,$P($G(^HLB(IEN,0)),"^")=ACKTO,$P($G(^HLB(IEN,0)),"^",4)="O" S RETURN=IEN
.E D
..S IEN=$P(ACKTO," ",2)
..S SUBIEN=$P(IEN,"-",2)
..S IEN=+IEN
..I IEN,SUBIEN,$P($G(^HLB(IEN,3,SUBIEN,0)),"^",2)=ACKTO,$P($G(^HLB(IEN,0)),"^",4)="O" S RETURN=IEN_"^"_SUBIEN
Q:RETURN RETURN
;
S COUNT=$$FINDMSG(ACKTO,.LIST)
I COUNT=1 D
.S RETURN=$S($P(LIST(1),"^",2):LIST(1),1:+LIST(1))
;
E I COUNT=0 D
.;no match found
E D
.;more than one potential match
.S COUNT=0
.F S COUNT=$O(LIST(COUNT)) Q:'COUNT D Q:RETURN
..S IEN=$P(LIST(COUNT),"^"),SUBIEN=$P(LIST(COUNT),"^",2)
..I 'SUBIEN D
...I $P($G(^HLB(IEN,0)),"^",7)=MSGID S RETURN=IEN
..E D
...I $P($G(^HLB(IEN,3,SUBIEN,0)),"^",4)=MSGID S RETURN=IEN_"^"_SUBIEN
.I 'RETURN S RETURN=$S($P(LIST(1),"^",2):LIST(1),1:+LIST(1))
;**P146 END CJM
Q RETURN
;
;
ACKBYIEN(MSGID,ACKBY) ;
;finds the ien of the ack message
;Input:
; MSGID - the msg id of the initial message
; ACKBY - msgid of the ack message
;Output: Function returns "" if not found, otherwise the IEN, or, if the message is in a batch, the <ien>^<subien>
;
N LIST,RETURN,COUNT,IEN,SUBIEN
S RETURN=""
;
;**P146 START CJM
I $P(ACKBY," "),$P(ACKBY," ")=$P($G(^HLD(779.1,1,0)),"^",2) D
.I '(ACKBY["-") D
..S IEN=$P(ACKBY," ",2)
..I IEN,$P($G(^HLB(IEN,0)),"^")=ACKBY,$P($G(^HLB(IEN,0)),"^",4)="O" S RETURN=IEN
.E D
..S IEN=$P(ACKBY," ",2)
..S SUBIEN=$P(IEN,"-",2)
..S IEN=+IEN
..I IEN,SUBIEN,$P($G(^HLB(IEN,3,SUBIEN,0)),"^",2)=ACKBY,$P($G(^HLB(IEN,0)),"^",4)="O" S RETURN=IEN_"^"_SUBIEN
Q:RETURN RETURN
;
S COUNT=$$FINDMSG(ACKBY,.LIST)
I COUNT=1 D
.S RETURN=$S($P(LIST(1),"^",2):LIST(1),1:+LIST(1))
;
E I COUNT=0 D
.;no match found
E D
.;more than one potential match
.S COUNT=0
.F S COUNT=$O(LIST(COUNT)) Q:'COUNT D Q:RETURN
..S IEN=$P(LIST(COUNT),"^"),SUBIEN=$P(LIST(COUNT),"^",2)
..I 'SUBIEN D
...I $P($G(^HLB(IEN,0)),"^",3)=MSGID S RETURN=IEN
..E D
...I $P($G(^HLB(IEN,3,SUBIEN,0)),"^",3)=MSGID S RETURN=IEN_"^"_SUBIEN
.I 'RETURN S RETURN=$S($P(LIST(1),"^",2):LIST(1),1:+LIST(1))
;**P146 END CJM
;
Q RETURN
;
GETMSGB(MSG,SUBIEN,SUBMSG) ;
;gets a message from within a batch
;Input:
; MSG (required, pass by reference) from $$GETMSG
; SUBIEN - the subrecord #
;Output:
; SUBMSG (pass by reference) These subscripts are returned:
; "ACK BY" - if this msg was app acked, the msg id if this msg that was app
; "ACK TO" - if this msg is an app ack, the msg id of msg being acked
; "EVENT" - HL7 Event
; "HDR",1) - fields 1-6 of the header segment
; "HDR",2) - fields 7-End of the header segment
; "ID" - Message Control ID
; "MESSAGE TYPE" - HL7 Message Type
; "STATUS" - completion status for the individual message
;
N NODE
S NODE=$G(^HLB(MSG("IEN"),3,SUBIEN,0))
S SUBMSG("ID")=$P(NODE,"^",2)
S SUBMSG("ACK TO")=$P(NODE,"^",3)
S SUBMSG("ACK BY")=$P(NODE,"^",4)
S SUBMSG("STATUS")=$P(NODE,"^",5)
S SUBMSG("HDR",1)=$G(^HLB(MSG("IEN"),3,SUBIEN,1)),SUBMSG("HDR",2)=$G(^(2))
S NODE=$G(^HLA(MSG("BODY"),2,SUBIEN,0))
S SUBMSG("MESSAGE TYPE")=$P(NODE,"^",2)
S SUBMSG("EVENT")=$P(NODE,"^",3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOMSG1 4425 printed Dec 13, 2024@01:58:47 Page 2
HLOMSG1 ;ALB/CJM-HL7 - APIs for files 777/778 (CONTINUED) ;06/19/2009
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,143**;Oct 13, 1995;Build 3
+2 ;
FINDMSG(MSGID,LIST) ;
+1 ;Given a message id, this function finds the file 778 entries having that message id. The count is returned as the function value. If the message
+2 ;is within a batch, it might be in the subfile. The list of found
+3 ;records is in the format LIST(1)=<IEN>^<SUBIEN>,LIST(2)=<IEN>^<SUBIEN>,
+4 ;etc., where SUBIEN="" if the message is not within a batch.
+5 ;
+6 NEW COUNT,MSG
+7 KILL LIST
+8 if $GET(MSGID)=""
QUIT 0
+9 SET (MSG,COUNT)=0
+10 FOR
SET MSG=$ORDER(^HLB("B",MSGID,MSG))
if 'MSG
QUIT
SET COUNT=COUNT+1
SET LIST(COUNT)=MSG
+11 SET MSG=""
+12 FOR
SET MSG=$ORDER(^HLB("AE",MSGID,MSG))
if MSG=""
QUIT
SET COUNT=COUNT+1
SET LIST(COUNT)=MSG
+13 QUIT COUNT
+14 ;
ACKTOIEN(MSGID,ACKTO) ;
+1 ;finds the ien of the initial message
+2 ;Input:
+3 ; MSGID - the msg id of the ack message
+4 ; ACKTO - msgid of the original message
+5 ;Output: Function returns "" if not found, otherwise the IEN, or, if the message is in a batch, the <ien>^<subien>
+6 ;
+7 NEW LIST,RETURN,COUNT,IEN,SUBIEN
+8 SET RETURN=""
+9 ;
+10 ;**P146 START CJM
+11 IF $PIECE(ACKTO," ")
IF $PIECE(ACKTO," ")=$PIECE($GET(^HLD(779.1,1,0)),"^",2)
Begin DoDot:1
+12 IF '(ACKTO["-")
Begin DoDot:2
+13 SET IEN=$PIECE(ACKTO," ",2)
+14 IF IEN
IF $PIECE($GET(^HLB(IEN,0)),"^")=ACKTO
IF $PIECE($GET(^HLB(IEN,0)),"^",4)="O"
SET RETURN=IEN
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 SET IEN=$PIECE(ACKTO," ",2)
+17 SET SUBIEN=$PIECE(IEN,"-",2)
+18 SET IEN=+IEN
+19 IF IEN
IF SUBIEN
IF $PIECE($GET(^HLB(IEN,3,SUBIEN,0)),"^",2)=ACKTO
IF $PIECE($GET(^HLB(IEN,0)),"^",4)="O"
SET RETURN=IEN_"^"_SUBIEN
End DoDot:2
End DoDot:1
+20 if RETURN
QUIT RETURN
+21 ;
+22 SET COUNT=$$FINDMSG(ACKTO,.LIST)
+23 IF COUNT=1
Begin DoDot:1
+24 SET RETURN=$SELECT($PIECE(LIST(1),"^",2):LIST(1),1:+LIST(1))
End DoDot:1
+25 ;
+26 IF '$TEST
IF COUNT=0
Begin DoDot:1
+27 ;no match found
End DoDot:1
+28 IF '$TEST
Begin DoDot:1
+29 ;more than one potential match
+30 SET COUNT=0
+31 FOR
SET COUNT=$ORDER(LIST(COUNT))
if 'COUNT
QUIT
Begin DoDot:2
+32 SET IEN=$PIECE(LIST(COUNT),"^")
SET SUBIEN=$PIECE(LIST(COUNT),"^",2)
+33 IF 'SUBIEN
Begin DoDot:3
+34 IF $PIECE($GET(^HLB(IEN,0)),"^",7)=MSGID
SET RETURN=IEN
End DoDot:3
+35 IF '$TEST
Begin DoDot:3
+36 IF $PIECE($GET(^HLB(IEN,3,SUBIEN,0)),"^",4)=MSGID
SET RETURN=IEN_"^"_SUBIEN
End DoDot:3
End DoDot:2
if RETURN
QUIT
+37 IF 'RETURN
SET RETURN=$SELECT($PIECE(LIST(1),"^",2):LIST(1),1:+LIST(1))
End DoDot:1
+38 ;**P146 END CJM
+39 QUIT RETURN
+40 ;
+41 ;
ACKBYIEN(MSGID,ACKBY) ;
+1 ;finds the ien of the ack message
+2 ;Input:
+3 ; MSGID - the msg id of the initial message
+4 ; ACKBY - msgid of the ack message
+5 ;Output: Function returns "" if not found, otherwise the IEN, or, if the message is in a batch, the <ien>^<subien>
+6 ;
+7 NEW LIST,RETURN,COUNT,IEN,SUBIEN
+8 SET RETURN=""
+9 ;
+10 ;**P146 START CJM
+11 IF $PIECE(ACKBY," ")
IF $PIECE(ACKBY," ")=$PIECE($GET(^HLD(779.1,1,0)),"^",2)
Begin DoDot:1
+12 IF '(ACKBY["-")
Begin DoDot:2
+13 SET IEN=$PIECE(ACKBY," ",2)
+14 IF IEN
IF $PIECE($GET(^HLB(IEN,0)),"^")=ACKBY
IF $PIECE($GET(^HLB(IEN,0)),"^",4)="O"
SET RETURN=IEN
End DoDot:2
+15 IF '$TEST
Begin DoDot:2
+16 SET IEN=$PIECE(ACKBY," ",2)
+17 SET SUBIEN=$PIECE(IEN,"-",2)
+18 SET IEN=+IEN
+19 IF IEN
IF SUBIEN
IF $PIECE($GET(^HLB(IEN,3,SUBIEN,0)),"^",2)=ACKBY
IF $PIECE($GET(^HLB(IEN,0)),"^",4)="O"
SET RETURN=IEN_"^"_SUBIEN
End DoDot:2
End DoDot:1
+20 if RETURN
QUIT RETURN
+21 ;
+22 SET COUNT=$$FINDMSG(ACKBY,.LIST)
+23 IF COUNT=1
Begin DoDot:1
+24 SET RETURN=$SELECT($PIECE(LIST(1),"^",2):LIST(1),1:+LIST(1))
End DoDot:1
+25 ;
+26 IF '$TEST
IF COUNT=0
Begin DoDot:1
+27 ;no match found
End DoDot:1
+28 IF '$TEST
Begin DoDot:1
+29 ;more than one potential match
+30 SET COUNT=0
+31 FOR
SET COUNT=$ORDER(LIST(COUNT))
if 'COUNT
QUIT
Begin DoDot:2
+32 SET IEN=$PIECE(LIST(COUNT),"^")
SET SUBIEN=$PIECE(LIST(COUNT),"^",2)
+33 IF 'SUBIEN
Begin DoDot:3
+34 IF $PIECE($GET(^HLB(IEN,0)),"^",3)=MSGID
SET RETURN=IEN
End DoDot:3
+35 IF '$TEST
Begin DoDot:3
+36 IF $PIECE($GET(^HLB(IEN,3,SUBIEN,0)),"^",3)=MSGID
SET RETURN=IEN_"^"_SUBIEN
End DoDot:3
End DoDot:2
if RETURN
QUIT
+37 IF 'RETURN
SET RETURN=$SELECT($PIECE(LIST(1),"^",2):LIST(1),1:+LIST(1))
End DoDot:1
+38 ;**P146 END CJM
+39 ;
+40 QUIT RETURN
+41 ;
GETMSGB(MSG,SUBIEN,SUBMSG) ;
+1 ;gets a message from within a batch
+2 ;Input:
+3 ; MSG (required, pass by reference) from $$GETMSG
+4 ; SUBIEN - the subrecord #
+5 ;Output:
+6 ; SUBMSG (pass by reference) These subscripts are returned:
+7 ; "ACK BY" - if this msg was app acked, the msg id if this msg that was app
+8 ; "ACK TO" - if this msg is an app ack, the msg id of msg being acked
+9 ; "EVENT" - HL7 Event
+10 ; "HDR",1) - fields 1-6 of the header segment
+11 ; "HDR",2) - fields 7-End of the header segment
+12 ; "ID" - Message Control ID
+13 ; "MESSAGE TYPE" - HL7 Message Type
+14 ; "STATUS" - completion status for the individual message
+15 ;
+16 NEW NODE
+17 SET NODE=$GET(^HLB(MSG("IEN"),3,SUBIEN,0))
+18 SET SUBMSG("ID")=$PIECE(NODE,"^",2)
+19 SET SUBMSG("ACK TO")=$PIECE(NODE,"^",3)
+20 SET SUBMSG("ACK BY")=$PIECE(NODE,"^",4)
+21 SET SUBMSG("STATUS")=$PIECE(NODE,"^",5)
+22 SET SUBMSG("HDR",1)=$GET(^HLB(MSG("IEN"),3,SUBIEN,1))
SET SUBMSG("HDR",2)=$GET(^(2))
+23 SET NODE=$GET(^HLA(MSG("BODY"),2,SUBIEN,0))
+24 SET SUBMSG("MESSAGE TYPE")=$PIECE(NODE,"^",2)
+25 SET SUBMSG("EVENT")=$PIECE(NODE,"^",3)
+26 QUIT
