VistA-FOIAVistA/r/HEALTH_LEVEL_SEVEN-HL/HLOPBLD1.m

94 lines
4.1 KiB
Mathematica
Raw Permalink Normal View History

HLOPBLD1 ;ALB/CJM-HL7 - Building segments (CONTINUED) ;10/24/2006
;;1.6;HEALTH LEVEL SEVEN;**126,132**;Oct 13, 1995;Build 6
;Per VHA Directive 2004-038, this routine should not be modified.
;
BUILDHDR(HLMSTATE,TYPE,HDR) ;Builds the header segment in 2 lines, line 1 is components 1-6
;Input:
; HLMSTATE("HDR") - (pass by reference, required) These subscripts are used:
; "FIELD SEPARATOR"
; "ENCODING CHARACTERS"
; "SENDING APPLICATION"
; "RECEIVING APPLICATION"
; "RECEIVING FACILITY",1 and ,2 and ,3
; "DT/TM OF MESSAGE"
; "SECURITY"
; "ACCEPT ACK TYPE"
; "APP ACK TYPE"
; "PROCESSING ID"
;
; *MSH ONLY*
; "CONTINUATION POINTER"
; "COUNTRY"
; "EVENT"
; "MESSAGE STRUCTURE"
; "MESSAGE TYPE"
; "PROCESSING MODE"
; "VERSION"
;
; *BHS ONLY*
; "REFERENCE BATCH CONTROL ID"
;
; HLMSTATE("BATCH")
; HLMSTATE("BATCH","CURRENT MESSAGE") - batch messages only
; HLMSTATE("IEN") - ien, file 778
;
; TYPE - must be either "MSH" or "BHS"
;
;Output:
; HLMSTATE("HDR") - these subscripts will be added, unless building an MSH within a batch:
; "SENDING FACILITY",1 and ,2 and ,3
; "PROCESSING ID"
; "MESSAGE CONTROL ID" (MSH ONLY)
; "BATCH CONTROL ID" (BHS ONLY)
; "DT/TM OF MESSAGE"
; HDR (pass by reference) This will return the segment in an array form at HDR(1),HDR(2) (two lines).
;
K HDR
N SEG,BATCH,LEN,FS,CS
;
;shortcuts
S HDR="HLMSTATE(""HDR"")"
S BATCH=HLMSTATE("BATCH")
S FS=@HDR@("FIELD SEPARATOR")
S CS=$E(@HDR@("ENCODING CHARACTERS"),1)
;
S HDR(1)=TYPE_FS_@HDR@("ENCODING CHARACTERS")_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("SENDING APPLICATION")))
;
;If building an MSH segment for a batch message, these parameters should already be determined
D:(('HLMSTATE("BATCH"))!(TYPE="BHS"))
.N PORT
.S PORT=$$RTRNPORT^HLOAPP($G(@HDR@("SENDING APPLICATION")))
.S:'PORT PORT=HLMSTATE("SYSTEM","PORT")
.S @HDR@("SENDING FACILITY",1)=HLMSTATE("SYSTEM","STATION")
.S @HDR@("SENDING FACILITY",2)=HLMSTATE("SYSTEM","DOMAIN")_":"_PORT
.S @HDR@("SENDING FACILITY",3)="DNS"
.;
.;create the unique message ids, using the ien from file 778
.S:TYPE="BHS" @HDR@("BATCH CONTROL ID")=HLMSTATE("SYSTEM","STATION")_" "_HLMSTATE("IEN")
.S:TYPE="MSH" @HDR@("MESSAGE CONTROL ID")=HLMSTATE("SYSTEM","STATION")_" "_HLMSTATE("IEN")
.;
.S @HDR@("PROCESSING ID")=HLMSTATE("SYSTEM","PROCESSING ID")
.S @HDR@("DT/TM OF MESSAGE")=$$HLDATE^HLFNC($$NOW^XLFDT,"TS")
;
S HDR(1)=HDR(1)_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("SENDING FACILITY",1)))_CS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("SENDING FACILITY",2)))_CS_"DNS"
S HDR(1)=HDR(1)_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("RECEIVING APPLICATION")))
S HDR(1)=HDR(1)_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("RECEIVING FACILITY",1)))_CS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("RECEIVING FACILITY",2)))
S HDR(1)=HDR(1)_CS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("RECEIVING FACILITY",3)))
S HDR(2)=FS_$$ESCAPE^HLOPBLD(.HLMSTATE,@HDR@("DT/TM OF MESSAGE"))_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("SECURITY")))
;
I TYPE="MSH" D
.N ID
.S HDR(2)=HDR(2)_FS_@HDR@("MESSAGE TYPE")_CS_@HDR@("EVENT")_CS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("MESSAGE STRUCTURE")))
.S:BATCH ID=@HDR@("BATCH CONTROL ID")_"-"_$G(HLMSTATE("BATCH","CURRENT MESSAGE"))
.S:'BATCH ID=@HDR@("MESSAGE CONTROL ID")
.S HDR(2)=HDR(2)_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,ID)_FS_@HDR@("PROCESSING ID")_CS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("PROCESSING MODE")))_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,@HDR@("VERSION"))
.S HDR(2)=HDR(2)_FS_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("CONTINUATION POINTER")))_FS_@HDR@("ACCEPT ACK TYPE")_FS_@HDR@("APP ACK TYPE")_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("COUNTRY")))
;
I TYPE="BHS" D
.N TEXT
.S TEXT="PROCESSING ID"_"="_@HDR@("PROCESSING ID")_" "
.I $L($G(@HDR@("ACCEPT ACK TYPE"))) S TEXT=TEXT_"ACCEPT ACK TYPE"_"="_@HDR@("ACCEPT ACK TYPE")_" "
.I $L($G(@HDR@("APP ACK TYPE"))) S TEXT=TEXT_"APP ACK TYPE"_"="_@HDR@("APP ACK TYPE")_" "
.S HDR(2)=HDR(2)_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,TEXT)_FS_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,@HDR@("BATCH CONTROL ID"))_FS_$$ESCAPE^HLOPBLD(.HLMSTATE,$G(@HDR@("REFERENCE BATCH CONTROL ID")))
Q