206 lines
8.1 KiB
Mathematica
206 lines
8.1 KiB
Mathematica
|
HLCSHDR3 ;SFIRMFO/LJA - Reset MSH Segment Fields ;03/24/04 11:19
|
||
|
|
;;1.6;HEALTH LEVEL SEVEN;**93,108**;Oct 13, 1995
|
||
|
|
;
|
||
|
|
; Reset RECEIVING APPLICATION and RECEIVING SITE of MSH segment - HL*1.6*93
|
||
|
|
;
|
||
|
|
RESET ; Called from HEADER^HLCSHDR1 & BHSHDR^HLCSHDR1, which is called by
|
||
|
|
; GENERATE^HLMA & GENACK^HLMA1.
|
||
|
|
N MTIEN
|
||
|
|
;
|
||
|
|
; Even if set already, set 772 IEN again...
|
||
|
|
S MTIEN=+$G(^HLMA(+$G(IEN),0)) QUIT:$G(^HL(772,+MTIEN,0))']"" ;->
|
||
|
|
;
|
||
|
|
; Different variables used for Event Protocol
|
||
|
|
D MSHCHG($G(HLEID),$S($G(EIDS)>0:+EIDS,1:+$G(HLEIDS)),$G(MTIEN),$G(IEN),.SERAPP,.SERFAC,.CLNTAPP,.CLNTFAC,.HLP)
|
||
|
|
;
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
MSHCHG(HLEID,EIDS,MTIEN,IEN,SERAPP,SERFAC,CLNTAPP,CLNTFAC,HLPARR) ; The parameters
|
||
|
|
; are the required input variables. Call here "by reference".
|
||
|
|
;
|
||
|
|
; HLEID=Event driver protocol IEN
|
||
|
|
; EIDS=Subscriber protocol IEN
|
||
|
|
; MTIEN=772 IEN
|
||
|
|
; IEN=773 IEN
|
||
|
|
; SERAPP=Sending App text
|
||
|
|
; SERFAC=Sending Fac text
|
||
|
|
;CLNTAPP=Rec (client) app text
|
||
|
|
;CLNTFAC=Rec (client) fac text
|
||
|
|
; HLP()=HLP("SUBSCRIBER") array
|
||
|
|
;
|
||
|
|
; The MSH segment is built (usually) in HLCSHDR1. Immediately before
|
||
|
|
; using the existing local variables to concatenate them together into
|
||
|
|
; the MSH segment, HLCSHDR1 calls here to see if some of the local
|
||
|
|
; variables should be reset.
|
||
|
|
;
|
||
|
|
; Resetting the local variables used in creating the MSH segment
|
||
|
|
; gives those creating HL7 messages control over the local variables
|
||
|
|
; that can be changed below.
|
||
|
|
;
|
||
|
|
; There are rules that govern what the creator of the MSH segment
|
||
|
|
; can change:
|
||
|
|
;
|
||
|
|
; Rule #1: The SENDING APPLICATION can be changed. Var=HLMSHSAN
|
||
|
|
; Rule #2: The SENDING FACILITY can be changed. Var=HLMSHSFN
|
||
|
|
; Rule #3: The RECEIVING APPLICATION can be changed. Var=HLMSHRAN
|
||
|
|
; Rule #4: The RECEIVING FACILITY can be changed. Var=HLMSHRFN
|
||
|
|
; Rule #5: No other fields in the MSH segment can be changed.
|
||
|
|
;
|
||
|
|
; If the passed in HLP() array entry used to reset the above four
|
||
|
|
; fields holds the text used, the variables above will be reset.
|
||
|
|
; If M code is used, the M code itself is responsible for setting
|
||
|
|
; these specific local variables.
|
||
|
|
;
|
||
|
|
; The following local variables are created and made available for
|
||
|
|
; use by M code:
|
||
|
|
;
|
||
|
|
; Protocol, Event: HLMSHPRE (IEN^NAME)
|
||
|
|
; Protocol, Subscriber: HLMSHPRS (IEN^NAME)
|
||
|
|
;
|
||
|
|
; HL Message Text file (#772) IEN: HLMSH772 (IEN)
|
||
|
|
; HL Message Admin file (#773) IEN: HLMSH773 (IEN)
|
||
|
|
;
|
||
|
|
; Sending Application, Original: HLMSHSAO (SERAPP)
|
||
|
|
; Sending Application, New: HLMSHSAN
|
||
|
|
; Sending Facility, Original: HLMSHSFO (SERFAC)
|
||
|
|
; Sending Facility, New: HLMSHSFN
|
||
|
|
; Receiving Application, Original: HLMSHRAO (CLNTAPP)
|
||
|
|
; Receiving Application, New: HLMSHRAN
|
||
|
|
; Receiving Facility, Original: HLMSHRFO (CLNTFAC)
|
||
|
|
; Receiving Facility, New: HLMSHRFN
|
||
|
|
;
|
||
|
|
; M Code SUBROUTINE: HLMSHTAG
|
||
|
|
; M Code ROUTINE: HLMSHRTN
|
||
|
|
;
|
||
|
|
; See the documentation in patch HL*1.6*93 in the Forum patch module
|
||
|
|
; for additional information.
|
||
|
|
;
|
||
|
|
; CLIENT -- req
|
||
|
|
;
|
||
|
|
; HLMSH-namespaced variables created below
|
||
|
|
N HLDEBUG,HLMSH101,HLMSH31,HLMSH31C,HLMSH32,HLMSH32C
|
||
|
|
N HLMSH33,HLMSH33C,HLMSH34,HLMSH34C,HLMSH772,HLMSH773,HLMSH91
|
||
|
|
N HLMSHAN,HLMSHFN,HLMSHPRE,HLMSHPRS
|
||
|
|
N HLMSHRTN,HLMSHRAN,HLMSHRAO,HLMSHRFN
|
||
|
|
N HLMSHRFO,HLMSHSAN,HLMSHSAO,HLMSHSFN,HLMSHSFO
|
||
|
|
N HLMSHPRO,HLMSHREF,HLMSHSUB,HLMSHTAG
|
||
|
|
;
|
||
|
|
; Non-HLMSH-namespaced variables created below
|
||
|
|
N HLPWAY,HLRAN,HLRFN,HLSAN,HLSFN,HLTYPE
|
||
|
|
;
|
||
|
|
;
|
||
|
|
; Set up variables pass #1...
|
||
|
|
S (HLMSH31,HLMSH32,HLMSH33,HLMSH34)=""
|
||
|
|
S (HLMSH31C,HLMSH32C,HLMSH33C,HLMSH34C)=""
|
||
|
|
S HLMSHPRE=$G(HLEID)_U_$P($G(^ORD(101,+$G(HLEID),0)),U) ; Event 101
|
||
|
|
S HLMSHPRS=$G(EIDS)_U_$P($G(^ORD(101,+$G(EIDS),0)),U) ; Sub 101
|
||
|
|
S HLMSH772=$G(MTIEN)
|
||
|
|
S HLMSH773=$G(IEN) QUIT:'$D(^HLMA(+HLMSH773,0)) ;->
|
||
|
|
;
|
||
|
|
; Get passed-in-by-reference HLP("SUBSCRIBER") data into variable...
|
||
|
|
S HLMSHPRO=$$HLMSHPRO QUIT:HLMSHPRO']"" ;->
|
||
|
|
;
|
||
|
|
; Should DEBUG data be stored? (This can be overwritten in $$HLMSHPRO)
|
||
|
|
I $G(HLDEBUG)']"" S HLDEBUG=$P($P(HLMSHPRO,"~",2),U,8)
|
||
|
|
; HLDEBUG might be already set in $$HLMSHPRO
|
||
|
|
S HLDEBUG=$TR(HLDEBUG,"- /",U) ; Change delimiters to ^
|
||
|
|
;
|
||
|
|
; HLDEBUG (#1-#2-#3) Explanation...
|
||
|
|
; -- #1 can be 0 (NO) or 1 (YES) for whether ^HLMA(#,90) data stored
|
||
|
|
; -- #2 can be 0 or 1 for whether ^HLMA(#,91) data should be stored
|
||
|
|
; -- #3 can be 0 or 1 or 2 for what type of ^XTMP data should be stored
|
||
|
|
; -- Data is stored in ^XTMP("HLCSHDR3 "_IEN773)
|
||
|
|
; -- 0 = No XTMP data should be stored
|
||
|
|
; -- 1 = Store only SOME of the data
|
||
|
|
; -- 2 = Store ALL variable data
|
||
|
|
;
|
||
|
|
; Store HLP("SUBSCRIBER"[,#]) in ^HLMA(#,90)
|
||
|
|
I $P(HLDEBUG,U)=1 D
|
||
|
|
. S X=$P(HLMSHPRO,"~",2) I X]"" S ^HLMA(+HLMSH773,90)=X
|
||
|
|
;
|
||
|
|
; Found by general HLP("SUBSCRIBER") or specific HLP("SUBSCRIBER",#) entry?
|
||
|
|
; patch HL*1.6*108 start
|
||
|
|
S HLPWAY=$P(HLMSHPRO,"~"),X=$L(HLMSHPRO,"~"),HLMSHREF=$P(HLMSHPRO,"~",+X),HLMSHPRO=$P(HLMSHPRO,"~",+2,+X-1)
|
||
|
|
; Above line modified by LJA - 3/18/04 Original line shown below.
|
||
|
|
; S HLPWAY=$P(HLMSHPRO,"~"),HLMSHREF=$P(HLMSHPRO,"~",3),HLMSHPRO=$P(HLMSHPRO,"~",2)
|
||
|
|
; patch HL*1.6*108 end
|
||
|
|
;
|
||
|
|
; Set up variables pass #2...
|
||
|
|
S HLMSHSAO=$G(SERAPP),(HLSAN,HLMSHSAN)=$P(HLMSHPRO,U,2) ; Send App
|
||
|
|
S HLMSHSFO=$G(SERFAC),(HLSFN,HLMSHSFN)=$P(HLMSHPRO,U,3) ; Send Fac
|
||
|
|
S HLMSHRAO=$G(CLNTAPP),(HLRAN,HLMSHRAN)=$P(HLMSHPRO,U,4) ; Rec App
|
||
|
|
S HLMSHRFO=$G(CLNTFAC),(HLRFN,HLMSHRFN)=$P(HLMSHPRO,U,5) ; Rec Fac
|
||
|
|
;
|
||
|
|
; If there's an Xecution routine, do now...
|
||
|
|
S HLMSHTAG=$P(HLMSHPRO,U,6),HLMSHRTN=$P(HLMSHPRO,U,7)
|
||
|
|
I HLMSHTAG]"",HLMSHRTN]"" D @HLMSHTAG^@HLMSHRTN
|
||
|
|
I HLMSHTAG']"",HLMSHRTN]"" D ^@HLMSHRTN
|
||
|
|
;
|
||
|
|
; Start work for ^HLMA(#,91) node...
|
||
|
|
S HLMSH91="" ; HLMSH91 is the data that will be stored in ^(91)
|
||
|
|
I SERAPP'=HLMSHSAN D SET91M(1,SERAPP,HLSAN,HLMSHSAN) ; Reset by M code?
|
||
|
|
I SERFAC'=HLMSHSFN D SET91M(3,SERFAC,HLSFN,HLMSHSFN)
|
||
|
|
I CLNTAPP'=HLMSHRAN D SET91M(5,CLNTAPP,HLRAN,HLMSHRAN)
|
||
|
|
I CLNTFAC'=HLMSHRFN D SET91M(7,CLNTFAC,HLRFN,HLMSHRFN)
|
||
|
|
;
|
||
|
|
; The real resetting of MSH segment variables work is done here...
|
||
|
|
D SET^HLCSHDR4(HLMSHSAN,"SERAPP",1) ; Update SERAPP if different, and DATA too...
|
||
|
|
D SET^HLCSHDR4(HLMSHSFN,"SERFAC",3) ; Etc
|
||
|
|
D SET^HLCSHDR4(HLMSHRAN,"CLNTAPP",5) ; Etc
|
||
|
|
D SET^HLCSHDR4(HLMSHRFN,"CLNTFAC",7) ; Etc
|
||
|
|
;
|
||
|
|
; Set ^HLMA(#,91) node if overwrites occurred...
|
||
|
|
I HLMSH91]"" S ^HLMA(+HLMSH773,91)=HLMSH91
|
||
|
|
;
|
||
|
|
; If debugging, record pre variable view...
|
||
|
|
D DEBUG^HLCSHDR4($P(HLDEBUG,U,3))
|
||
|
|
;
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
SET91M(PCE,MSH,PREM,POSTM) ; If M code re/set the MSH field, record...
|
||
|
|
QUIT:PREM=POSTM ;-> M code did not change anything...
|
||
|
|
S $P(HLMSH91,U,PCE)=MSH ; original (pre-overwrite) value
|
||
|
|
S $P(HLMSH91,U,PCE+1)="M" ; Overwrite source (A/M)
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
HLMSHPRO() ; Determines whether to use the generic HLP("SUBSCRIBER") data,
|
||
|
|
; or instead - if existent - the HLP("SUBSCRIBER",#)=SUB PROTOCOL^... data
|
||
|
|
;CLIENT -- req
|
||
|
|
N HLD,HLFIND,HLI,HLMSHREF,HLMSHSUB,HLX
|
||
|
|
;
|
||
|
|
; Get the default information...
|
||
|
|
S HLMSHSUB=$G(HLP("SUBSCRIBER")),HLMSHREF=999
|
||
|
|
;
|
||
|
|
; Overwrite HLMSHSUB if found...
|
||
|
|
S HLI=0,HLFIND=""
|
||
|
|
F S HLI=$O(HLP("SUBSCRIBER",HLI)) Q:HLI'>0!(HLFIND]"") D
|
||
|
|
. S HLD=$G(HLP("SUBSCRIBER",+HLI)) QUIT:HLD']"" ;->
|
||
|
|
. S HLD=$P(HLD,U) QUIT:HLD']"" ;->
|
||
|
|
. ; If passed name..
|
||
|
|
. I HLD'=+HLD S HLD=$$FIND101(HLD)
|
||
|
|
. ; Must have IEN by now...
|
||
|
|
. QUIT:+HLD'=+HLMSHPRS ;-> Not for right subscriber protocol
|
||
|
|
. S HLFIND=HLP("SUBSCRIBER",+HLI),HLMSHREF=+HLI
|
||
|
|
;
|
||
|
|
; Backdoor overwrite of HLDEBUG value...
|
||
|
|
; - This is a very important back door!! Even if applications
|
||
|
|
; - aren't logging debug data, it can be turned on by setting
|
||
|
|
; - ^XTMP("HLCSHDR3 DEBUG","DEBUG") or ^XTMP("HLCSHDR3 DEBUG","DEBUG",SUB-101)
|
||
|
|
; If the GENERAL entry exists, set HLDEBUG. Might be written next line though
|
||
|
|
S HLX=$G(^XTMP("HLCSHDR3 DEBUG","DEBUG")) I HLX]"" S HLDEBUG=HLX
|
||
|
|
; If a SPECIFIC entry found, reset HLDEBUG to it...
|
||
|
|
S HLX=$G(^XTMP("HLCSHDR3 DEBUG","DEBUG",+HLFIND)) I HLX]"" S HLDEBUG=HLX
|
||
|
|
;
|
||
|
|
QUIT $S(HLFIND]"":"S~"_HLFIND_"~"_HLMSHREF,HLMSHSUB]"":"G~"_HLMSHSUB_"~"_HLMSHREF,1:"")
|
||
|
|
;
|
||
|
|
FIND101(PROTNM) ; Find 101 entry...
|
||
|
|
N D,DIC,X,Y
|
||
|
|
S DIC="^ORD(101,",DIC(0)="MQ",D="B",X=PROTNM
|
||
|
|
D MIX^DIC1
|
||
|
|
QUIT $S(Y>0:+Y,1:"")
|
||
|
|
;
|
||
|
|
SHOW773(IEN773) ; Show reset info from 773 entry...
|
||
|
|
QUIT
|
||
|
|
;
|
||
|
|
EOR ;HLCSHDR3 - Reset MSH Segment Fields ;9/12/02 11:50
|