HLOSRVR2 ;ALB/CJM-HL7 - HLO Server ;02/29/2012
;;1.6;HEALTH LEVEL SEVEN;**131,137,138,146,158**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
NEWMSG(HLCSTATE,HLMSTATE,HDR) ;
;initialize the HLMSTATE array after reading the header
;Inputs:
; HLCSTATE (pass by reference)
; HDR (pass by reference) parsed header
;Output:
; HLMSTATE (pass by reference)
;
K HLMSTATE
S HLMSTATE("IEN")=""
S HLMSTATE("BODY")=""
S HLMSTATE("DIRECTION")="IN"
S HLMSTATE("CURRENT SEGMENT")=0 ;no segments in cache
S HLMSTATE("UNSTORED LINES")=1 ;just the header in cache so far
S HLMSTATE("LINE COUNT")=0 ;no lines within message stored to disk
I HDR("SEGMENT TYPE")="BHS" D
.S HLMSTATE("BATCH")=1
.S HLMSTATE("ID")=HDR("BATCH CONTROL ID")
.S HLMSTATE("BATCH","CURRENT MESSAGE")=0 ;no messages in batch
.S HLMSTATE("UNSTORED MSH")=0
E D
.S HLMSTATE("BATCH")=0
.S HLMSTATE("ID")=HDR("MESSAGE CONTROL ID")
M HLMSTATE("HDR")=HDR
M HLMSTATE("SYSTEM")=HLCSTATE("SYSTEM")
S HLMSTATE("STATUS")=""
S HLMSTATE("STATUS","QUEUE")=""
S HLMSTATE("STATUS","ACTION")=""
S HLMSTATE("STATUS","LINK NAME")=HLCSTATE("LINK","NAME")
S HLMSTATE("STATUS","PORT")=$P(HDR("SENDING FACILITY",2),":",2)
;
;if this is a batch, and it references another batch, assume it is a batch of app acks
;** START 138 CJM
;I HLMSTATE("BATCH"),HLMSTATE("ID")]"" D
I HLMSTATE("BATCH"),HLMSTATE("HDR","REFERENCE BATCH CONTROL ID")]"" D
.N IEN
.;S HLMSTATE("ACK TO")=HLMSTATE("ID")
.S HLMSTATE("ACK TO")=HLMSTATE("HDR","REFERENCE BATCH CONTROL ID")
.S HLMSTATE("ACK TO","STATUS")="SU"
.;S IEN=$O(^HLB("B",HLMSTATE("ID"),0))
.S IEN=$O(^HLB("B",HLMSTATE("HDR","REFERENCE BATCH CONTROL ID"),0))
.;** END 138 CJM
.I IEN S HLMSTATE("ACK TO IEN")=IEN_"^"
E S HLMSTATE("ACK TO")=""
I 'HLMSTATE("BATCH"),HDR("ACCEPT ACK TYPE")="",HDR("APP ACK TYPE")="" D
.S HLMSTATE("ORIGINAL MODE")=1
E D
.S HLMSTATE("ORIGINAL MODE")=0
N I F I=1,3 S HLMSTATE("MSA",I)=""
S HLMSTATE("MSA",2)=HLMSTATE("ID")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOSRVR2 2075 printed Dec 13, 2024@01:59:10 Page 2
HLOSRVR2 ;ALB/CJM-HL7 - HLO Server ;02/29/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**131,137,138,146,158**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
NEWMSG(HLCSTATE,HLMSTATE,HDR) ;
+1 ;initialize the HLMSTATE array after reading the header
+2 ;Inputs:
+3 ; HLCSTATE (pass by reference)
+4 ; HDR (pass by reference) parsed header
+5 ;Output:
+6 ; HLMSTATE (pass by reference)
+7 ;
+8 KILL HLMSTATE
+9 SET HLMSTATE("IEN")=""
+10 SET HLMSTATE("BODY")=""
+11 SET HLMSTATE("DIRECTION")="IN"
+12 ;no segments in cache
SET HLMSTATE("CURRENT SEGMENT")=0
+13 ;just the header in cache so far
SET HLMSTATE("UNSTORED LINES")=1
+14 ;no lines within message stored to disk
SET HLMSTATE("LINE COUNT")=0
+15 IF HDR("SEGMENT TYPE")="BHS"
Begin DoDot:1
+16 SET HLMSTATE("BATCH")=1
+17 SET HLMSTATE("ID")=HDR("BATCH CONTROL ID")
+18 ;no messages in batch
SET HLMSTATE("BATCH","CURRENT MESSAGE")=0
+19 SET HLMSTATE("UNSTORED MSH")=0
End DoDot:1
+20 IF '$TEST
Begin DoDot:1
+21 SET HLMSTATE("BATCH")=0
+22 SET HLMSTATE("ID")=HDR("MESSAGE CONTROL ID")
End DoDot:1
+23 MERGE HLMSTATE("HDR")=HDR
+24 MERGE HLMSTATE("SYSTEM")=HLCSTATE("SYSTEM")
+25 SET HLMSTATE("STATUS")=""
+26 SET HLMSTATE("STATUS","QUEUE")=""
+27 SET HLMSTATE("STATUS","ACTION")=""
+28 SET HLMSTATE("STATUS","LINK NAME")=HLCSTATE("LINK","NAME")
+29 SET HLMSTATE("STATUS","PORT")=$PIECE(HDR("SENDING FACILITY",2),":",2)
+30 ;
+31 ;if this is a batch, and it references another batch, assume it is a batch of app acks
+32 ;** START 138 CJM
+33 ;I HLMSTATE("BATCH"),HLMSTATE("ID")]"" D
+34 IF HLMSTATE("BATCH")
IF HLMSTATE("HDR","REFERENCE BATCH CONTROL ID")]""
Begin DoDot:1
+35 NEW IEN
+36 ;S HLMSTATE("ACK TO")=HLMSTATE("ID")
+37 SET HLMSTATE("ACK TO")=HLMSTATE("HDR","REFERENCE BATCH CONTROL ID")
+38 SET HLMSTATE("ACK TO","STATUS")="SU"
+39 ;S IEN=$O(^HLB("B",HLMSTATE("ID"),0))
+40 SET IEN=$ORDER(^HLB("B",HLMSTATE("HDR","REFERENCE BATCH CONTROL ID"),0))
+41 ;** END 138 CJM
+42 IF IEN
SET HLMSTATE("ACK TO IEN")=IEN_"^"
End DoDot:1
+43 IF '$TEST
SET HLMSTATE("ACK TO")=""
+44 IF 'HLMSTATE("BATCH")
IF HDR("ACCEPT ACK TYPE")=""
IF HDR("APP ACK TYPE")=""
Begin DoDot:1
+45 SET HLMSTATE("ORIGINAL MODE")=1
End DoDot:1
+46 IF '$TEST
Begin DoDot:1
+47 SET HLMSTATE("ORIGINAL MODE")=0
End DoDot:1
+48 NEW I
FOR I=1,3
SET HLMSTATE("MSA",I)=""
+49 SET HLMSTATE("MSA",2)=HLMSTATE("ID")
+50 QUIT
