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
HLCSHDR3 ;SFIRMFO/LJA - Reset MSH Segment Fields ;03/24/04 11:19
+1 ;;1.6;HEALTH LEVEL SEVEN;**93,108**;Oct 13, 1995
+2 ;
+3 ; Reset RECEIVING APPLICATION and RECEIVING SITE of MSH segment - HL*1.6*93
+4 ;
RESET ; Called from HEADER^HLCSHDR1 & BHSHDR^HLCSHDR1, which is called by
+1 ; GENERATE^HLMA & GENACK^HLMA1.
+2 NEW MTIEN
+3 ;
+4 ; Even if set already, set 772 IEN again...
+5 ;->
SET MTIEN=+$GET(^HLMA(+$GET(IEN),0))
IF $GET(^HL(772,+MTIEN,0))']""
QUIT
+6 ;
+7 ; Different variables used for Event Protocol
+8 DO MSHCHG($GET(HLEID),$SELECT($GET(EIDS)>0:+EIDS,1:+$GET(HLEIDS)),$GET(MTIEN),$GET(IEN),.SERAPP,.SERFAC,.CLNTAPP,.CLNTFAC,.HLP)
+9 ;
+10 QUIT
+11 ;
MSHCHG(HLEID,EIDS,MTIEN,IEN,SERAPP,SERFAC,CLNTAPP,CLNTFAC,HLPARR) ; The parameters
+1 ; are the required input variables. Call here "by reference".
+2 ;
+3 ; HLEID=Event driver protocol IEN
+4 ; EIDS=Subscriber protocol IEN
+5 ; MTIEN=772 IEN
+6 ; IEN=773 IEN
+7 ; SERAPP=Sending App text
+8 ; SERFAC=Sending Fac text
+9 ;CLNTAPP=Rec (client) app text
+10 ;CLNTFAC=Rec (client) fac text
+11 ; HLP()=HLP("SUBSCRIBER") array
+12 ;
+13 ; The MSH segment is built (usually) in HLCSHDR1. Immediately before
+14 ; using the existing local variables to concatenate them together into
+15 ; the MSH segment, HLCSHDR1 calls here to see if some of the local
+16 ; variables should be reset.
+17 ;
+18 ; Resetting the local variables used in creating the MSH segment
+19 ; gives those creating HL7 messages control over the local variables
+20 ; that can be changed below.
+21 ;
+22 ; There are rules that govern what the creator of the MSH segment
+23 ; can change:
+24 ;
+25 ; Rule #1: The SENDING APPLICATION can be changed. Var=HLMSHSAN
+26 ; Rule #2: The SENDING FACILITY can be changed. Var=HLMSHSFN
+27 ; Rule #3: The RECEIVING APPLICATION can be changed. Var=HLMSHRAN
+28 ; Rule #4: The RECEIVING FACILITY can be changed. Var=HLMSHRFN
+29 ; Rule #5: No other fields in the MSH segment can be changed.
+30 ;
+31 ; If the passed in HLP() array entry used to reset the above four
+32 ; fields holds the text used, the variables above will be reset.
+33 ; If M code is used, the M code itself is responsible for setting
+34 ; these specific local variables.
+35 ;
+36 ; The following local variables are created and made available for
+37 ; use by M code:
+38 ;
+39 ; Protocol, Event: HLMSHPRE (IEN^NAME)
+40 ; Protocol, Subscriber: HLMSHPRS (IEN^NAME)
+41 ;
+42 ; HL Message Text file (#772) IEN: HLMSH772 (IEN)
+43 ; HL Message Admin file (#773) IEN: HLMSH773 (IEN)
+44 ;
+45 ; Sending Application, Original: HLMSHSAO (SERAPP)
+46 ; Sending Application, New: HLMSHSAN
+47 ; Sending Facility, Original: HLMSHSFO (SERFAC)
+48 ; Sending Facility, New: HLMSHSFN
+49 ; Receiving Application, Original: HLMSHRAO (CLNTAPP)
+50 ; Receiving Application, New: HLMSHRAN
+51 ; Receiving Facility, Original: HLMSHRFO (CLNTFAC)
+52 ; Receiving Facility, New: HLMSHRFN
+53 ;
+54 ; M Code SUBROUTINE: HLMSHTAG
+55 ; M Code ROUTINE: HLMSHRTN
+56 ;
+57 ; See the documentation in patch HL*1.6*93 in the Forum patch module
+58 ; for additional information.
+59 ;
+60 ; CLIENT -- req
+61 ;
+62 ; HLMSH-namespaced variables created below
+63 NEW HLDEBUG,HLMSH101,HLMSH31,HLMSH31C,HLMSH32,HLMSH32C
+64 NEW HLMSH33,HLMSH33C,HLMSH34,HLMSH34C,HLMSH772,HLMSH773,HLMSH91
+65 NEW HLMSHAN,HLMSHFN,HLMSHPRE,HLMSHPRS
+66 NEW HLMSHRTN,HLMSHRAN,HLMSHRAO,HLMSHRFN
+67 NEW HLMSHRFO,HLMSHSAN,HLMSHSAO,HLMSHSFN,HLMSHSFO
+68 NEW HLMSHPRO,HLMSHREF,HLMSHSUB,HLMSHTAG
+69 ;
+70 ; Non-HLMSH-namespaced variables created below
+71 NEW HLPWAY,HLRAN,HLRFN,HLSAN,HLSFN,HLTYPE
+72 ;
+73 ;
+74 ; Set up variables pass #1...
+75 SET (HLMSH31,HLMSH32,HLMSH33,HLMSH34)=""
+76 SET (HLMSH31C,HLMSH32C,HLMSH33C,HLMSH34C)=""
+77 ; Event 101
SET HLMSHPRE=$GET(HLEID)_U_$PIECE($GET(^ORD(101,+$GET(HLEID),0)),U)
+78 ; Sub 101
SET HLMSHPRS=$GET(EIDS)_U_$PIECE($GET(^ORD(101,+$GET(EIDS),0)),U)
+79 SET HLMSH772=$GET(MTIEN)
+80 ;->
SET HLMSH773=$GET(IEN)
IF '$DATA(^HLMA(+HLMSH773,0))
QUIT
+81 ;
+82 ; Get passed-in-by-reference HLP("SUBSCRIBER") data into variable...
+83 ;->
SET HLMSHPRO=$$HLMSHPRO
IF HLMSHPRO']""
QUIT
+84 ;
+85 ; Should DEBUG data be stored? (This can be overwritten in $$HLMSHPRO)
+86 IF $GET(HLDEBUG)']""
SET HLDEBUG=$PIECE($PIECE(HLMSHPRO,"~",2),U,8)
+87 ; HLDEBUG might be already set in $$HLMSHPRO
+88 ; Change delimiters to ^
SET HLDEBUG=$TRANSLATE(HLDEBUG,"- /",U)
+89 ;
+90 ; HLDEBUG (#1-#2-#3) Explanation...
+91 ; -- #1 can be 0 (NO) or 1 (YES) for whether ^HLMA(#,90) data stored
+92 ; -- #2 can be 0 or 1 for whether ^HLMA(#,91) data should be stored
+93 ; -- #3 can be 0 or 1 or 2 for what type of ^XTMP data should be stored
+94 ; -- Data is stored in ^XTMP("HLCSHDR3 "_IEN773)
+95 ; -- 0 = No XTMP data should be stored
+96 ; -- 1 = Store only SOME of the data
+97 ; -- 2 = Store ALL variable data
+98 ;
+99 ; Store HLP("SUBSCRIBER"[,#]) in ^HLMA(#,90)
+100 IF $PIECE(HLDEBUG,U)=1
Begin DoDot:1
+101 SET X=$PIECE(HLMSHPRO,"~",2)
IF X]""
SET ^HLMA(+HLMSH773,90)=X
End DoDot:1
+102 ;
+103 ; Found by general HLP("SUBSCRIBER") or specific HLP("SUBSCRIBER",#) entry?
+104 ; patch HL*1.6*108 start
+105 SET HLPWAY=$PIECE(HLMSHPRO,"~")
SET X=$LENGTH(HLMSHPRO,"~")
SET HLMSHREF=$PIECE(HLMSHPRO,"~",+X)
SET HLMSHPRO=$PIECE(HLMSHPRO,"~",+2,+X-1)
+106 ; Above line modified by LJA - 3/18/04 Original line shown below.
+107 ; S HLPWAY=$P(HLMSHPRO,"~"),HLMSHREF=$P(HLMSHPRO,"~",3),HLMSHPRO=$P(HLMSHPRO,"~",2)
+108 ; patch HL*1.6*108 end
+109 ;
+110 ; Set up variables pass #2...
+111 ; Send App
SET HLMSHSAO=$GET(SERAPP)
SET (HLSAN,HLMSHSAN)=$PIECE(HLMSHPRO,U,2)
+112 ; Send Fac
SET HLMSHSFO=$GET(SERFAC)
SET (HLSFN,HLMSHSFN)=$PIECE(HLMSHPRO,U,3)
+113 ; Rec App
SET HLMSHRAO=$GET(CLNTAPP)
SET (HLRAN,HLMSHRAN)=$PIECE(HLMSHPRO,U,4)
+114 ; Rec Fac
SET HLMSHRFO=$GET(CLNTFAC)
SET (HLRFN,HLMSHRFN)=$PIECE(HLMSHPRO,U,5)
+115 ;
+116 ; If there's an Xecution routine, do now...
+117 SET HLMSHTAG=$PIECE(HLMSHPRO,U,6)
SET HLMSHRTN=$PIECE(HLMSHPRO,U,7)
+118 IF HLMSHTAG]""
IF HLMSHRTN]""
DO @HLMSHTAG^@HLMSHRTN
+119 IF HLMSHTAG']""
IF HLMSHRTN]""
DO ^@HLMSHRTN
+120 ;
+121 ; Start work for ^HLMA(#,91) node...
+122 ; HLMSH91 is the data that will be stored in ^(91)
SET HLMSH91=""
+123 ; Reset by M code?
IF SERAPP'=HLMSHSAN
DO SET91M(1,SERAPP,HLSAN,HLMSHSAN)
+124 IF SERFAC'=HLMSHSFN
DO SET91M(3,SERFAC,HLSFN,HLMSHSFN)
+125 IF CLNTAPP'=HLMSHRAN
DO SET91M(5,CLNTAPP,HLRAN,HLMSHRAN)
+126 IF CLNTFAC'=HLMSHRFN
DO SET91M(7,CLNTFAC,HLRFN,HLMSHRFN)
+127 ;
+128 ; The real resetting of MSH segment variables work is done here...
+129 ; Update SERAPP if different, and DATA too...
DO SET^HLCSHDR4(HLMSHSAN,"SERAPP",1)
+130 ; Etc
DO SET^HLCSHDR4(HLMSHSFN,"SERFAC",3)
+131 ; Etc
DO SET^HLCSHDR4(HLMSHRAN,"CLNTAPP",5)
+132 ; Etc
DO SET^HLCSHDR4(HLMSHRFN,"CLNTFAC",7)
+133 ;
+134 ; Set ^HLMA(#,91) node if overwrites occurred...
+135 IF HLMSH91]""
SET ^HLMA(+HLMSH773,91)=HLMSH91
+136 ;
+137 ; If debugging, record pre variable view...
+138 DO DEBUG^HLCSHDR4($PIECE(HLDEBUG,U,3))
+139 ;
+140 QUIT
+141 ;
SET91M(PCE,MSH,PREM,POSTM) ; If M code re/set the MSH field, record...
+1 ;-> M code did not change anything...
IF PREM=POSTM
QUIT
+2 ; original (pre-overwrite) value
SET $PIECE(HLMSH91,U,PCE)=MSH
+3 ; Overwrite source (A/M)
SET $PIECE(HLMSH91,U,PCE+1)="M"
+4 QUIT
+5 ;
HLMSHPRO() ; Determines whether to use the generic HLP("SUBSCRIBER") data,
+1 ; or instead - if existent - the HLP("SUBSCRIBER",#)=SUB PROTOCOL^... data
+2 ;CLIENT -- req
+3 NEW HLD,HLFIND,HLI,HLMSHREF,HLMSHSUB,HLX
+4 ;
+5 ; Get the default information...
+6 SET HLMSHSUB=$GET(HLP("SUBSCRIBER"))
SET HLMSHREF=999
+7 ;
+8 ; Overwrite HLMSHSUB if found...
+9 SET HLI=0
SET HLFIND=""
+10 FOR
SET HLI=$ORDER(HLP("SUBSCRIBER",HLI))
IF HLI'>0!(HLFIND]"")
QUIT
Begin DoDot:1
+11 ;->
SET HLD=$GET(HLP("SUBSCRIBER",+HLI))
IF HLD']""
QUIT
+12 ;->
SET HLD=$PIECE(HLD,U)
IF HLD']""
QUIT
+13 ; If passed name..
+14 IF HLD'=+HLD
SET HLD=$$FIND101(HLD)
+15 ; Must have IEN by now...
+16 ;-> Not for right subscriber protocol
IF +HLD'=+HLMSHPRS
QUIT
+17 SET HLFIND=HLP("SUBSCRIBER",+HLI)
SET HLMSHREF=+HLI
End DoDot:1
+18 ;
+19 ; Backdoor overwrite of HLDEBUG value...
+20 ; - This is a very important back door!! Even if applications
+21 ; - aren't logging debug data, it can be turned on by setting
+22 ; - ^XTMP("HLCSHDR3 DEBUG","DEBUG") or ^XTMP("HLCSHDR3 DEBUG","DEBUG",SUB-101)
+23 ; If the GENERAL entry exists, set HLDEBUG. Might be written next line though
+24 SET HLX=$GET(^XTMP("HLCSHDR3 DEBUG","DEBUG"))
IF HLX]""
SET HLDEBUG=HLX
+25 ; If a SPECIFIC entry found, reset HLDEBUG to it...
+26 SET HLX=$GET(^XTMP("HLCSHDR3 DEBUG","DEBUG",+HLFIND))
IF HLX]""
SET HLDEBUG=HLX
+27 ;
+28 QUIT $SELECT(HLFIND]"":"S~"_HLFIND_"~"_HLMSHREF,HLMSHSUB]"":"G~"_HLMSHSUB_"~"_HLMSHREF,1:"")
+29 ;
FIND101(PROTNM) ; Find 101 entry...
+1 NEW D,DIC,X,Y
+2 SET DIC="^ORD(101,"
SET DIC(0)="MQ"
SET D="B"
SET X=PROTNM
+3 DO MIX^DIC1
+4 QUIT $SELECT(Y>0:+Y,1:"")
+5 ;
SHOW773(IEN773) ; Show reset info from 773 entry...
+1 QUIT
+2 ;
EOR ;HLCSHDR3 - Reset MSH Segment Fields ;9/12/02 11:50
