Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLCSHDR3

HLCSHDR3.m

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