- 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 Feb 18, 2025@23:25:34 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