HLCSHDR4 ;SFIRMFO/LJA - Reset MSH Segment Fields ;10/09/2007 15:05
;;1.6;HEALTH LEVEL SEVEN;**93,108,122**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified
;
DEBUG(STORE) ; If HLP set up for debugging, capture VIEW...
; HLMSH773 -- req
;
N NOW,NUM,VAR,VARS,X,XTMP
;
; 1=some, 2=all
S STORE=$S(STORE=1:1,STORE=2:2,1:0) QUIT:'STORE ;->
;
S NOW=$$NOW^XLFDT
;
S XTMP="HLCSHDR3 "_HLMSH773
S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,0,4)_U_NOW_U_"Debug data created by DEBUG~HLCSHDR4"
;
S NUM=$O(^XTMP(XTMP,":"),-1)+1
;
; Grab only critical (some) variables?
I STORE=1 D
.
. ; Sending information...
. S ^XTMP(XTMP,NUM,"SA")=HLMSHSAO_U_HLSAN_U_HLMSHSAN
. S ^XTMP(XTMP,NUM,"SF")=HLMSHSFO_U_HLSFN_U_HLMSHSFN
.
. ; Receiving information...
. S ^XTMP(XTMP,NUM,"RA")=HLMSHRAO_U_HLRAN_U_HLMSHRAN
. S ^XTMP(XTMP,NUM,"RF")=HLMSHRFO_U_HLRFN_U_HLMSHRFN
.
. ; Other information... (HLMSHPRE and HLMSHPRS hold 2 pieces!)
. S ^XTMP(XTMP,NUM,0)=NOW_U_HLMSH772_U_HLMSHPRE_U_HLMSHPRS
. S ^XTMP(XTMP,NUM,1)=HLMSHPRO
;
; Grab all variables?
I STORE=2 D
. S X="^XTMP("""_XTMP_""","_NUM_","
. D DOLRO^%ZOSV
;
QUIT
;
SHOW N I773
F R !!,"Enter 773 IEN: ",I773:60 Q:I773'>0 D
. D SHOW773(I773)
QUIT
;
SHOW773(I773) ; Show Dynamic Routing MSH Field Reset Details
N DIV,MSH,N90,N91
;
S N90=$G(^HLMA(+I773,90)),N91=$G(^HLMA(+I773,91))
I (N90_N91)']"" D QUIT ;->
. W " no debug data found..."
;
S MSH=$G(^HLMA(+I773,"MSH",1,0)) QUIT:MSH']"" ;->
S DIV=$E(MSH,4)
;
W !!,$$CJ^XLFSTR(" 773 # "_I773_" ",IOM,"=")
;
D HDR(90,N90)
;
W !
D HDR(91,N91)
;
W !!,$E(MSH,1,IOM)
;
S C1=10,C2=30,C3=50
W !!,?C1,"Original (91)",?2,"Array (90)",?3,"MSH-Segment"
W !,$$REPEAT^XLFSTR("-",IOM)
D LINE("snd app",1,2,3)
D LINE("snd fac",3,3,4)
D LINE("rec app",5,4,5)
D LINE("rec fac",7,5,6)
;
QUIT
;
LINE(HDR,PCE1,PCE2,PCE3) ; Print one comparison line...
N P1,P2,P3,P4
S P1=$P(N91,U,PCE1),P2=$P(N90,U,PCE2),P3=$P(MSH,DIV,PCE3),P4=$P(N91,U,PCE1+1)
W !,HDR,":",?C1,P1,?2,P2,?3,P3,$S(P4]"":" ["_P4_"]",1:"")
QUIT
;
HDR(NUM,DATA) N TXT
S TXT=$S(NUM=90:"Array (90)",NUM=91:"Original (91)",1:"")
W !,$$CJ^XLFSTR("---------- "_TXT_" ----------",IOM)
W $$CJ^XLFSTR(DATA,IOM)
QUIT
;
SET(NEW,VAR,PCE) ; This subroutine performs these actions:
; (1) Resets variables used in MSH segment
; (2) Resets SERAPP and CLNTAPP in ^HLMA(#,0)
; (3) Sets HLMSH91 nodes if overwrite occurs by ARRAY value.
; If overwrite occurs by M code, the overwrite has already
; been recorded in HLMSH91. (An overwrite produced by M code
; is never overwritten by ARRAY data.)
;
N IEN771N,IEN771O,HLTCP
;
; VAR is the name of the variable, and not it's value...
S PRE=@VAR ; PRE is now the value of the VAR (pre-overwrite) variable...
;
; Tests whether anything was changed...
QUIT:NEW']"" ;-> No new value exists to change to...
QUIT:NEW=PRE ;-> New value = Original value. Nothing changed...
;
; THIS IS THE EPICENTER!! This is where the variables used in
; the MSH segment is overwritten.
S @VAR=NEW
;
; If PRE exists at this point, it was done by M code...
QUIT:$P(HLMSH91,U,PCE)]"" ;->
;
; Change was made, but not by M code. Must be by array...
S $P(HLMSH91,U,PCE)=PRE,$P(HLMSH91,U,PCE+1)="A"
;
; patch HL*1.6*122: for "^" as component separater
S $P(HLMSH91,U,PCE+2,999)=""
;
; Upgrade ^HLMA(#,0)...
QUIT:PCE'=1&(PCE'=5) ;->
;
; patch HL*1.6*108 start
;S IEN771O=$O(^HL(771,"B",PRE,0)) QUIT:IEN771O'>0 ;-> Orig IEN
;S IEN771N=$O(^HL(771,"B",NEW,0)) QUIT:IEN771N'>0 ;-> New IEN
S IEN771O=$O(^HL(771,"B",$E(PRE,1,30),0)) QUIT:IEN771O'>0 ;-> Orig IEN
S IEN771N=$O(^HL(771,"B",$E(NEW,1,30),0)) QUIT:IEN771N'>0 ;-> New IEN
; patch HL*1.6*108 end
;
QUIT:'IEN771O!('IEN771N)!(IEN771O=IEN771N) ;->
S HLTCP=1 ; So 773 is updated...
I PCE=1 D UPDATE^HLTF0(MTIENS,"","O","","",IEN771N)
I PCE=5 D UPDATE^HLTF0(MTIENS,"","O","",IEN771N)
;
QUIT
;
FIELDS ; Display the Protocol file fields used by the VistA HL7 package,
; when messages are received, to find the event and subscriber
; protocols.
N BY,DIC,DIOEND,L
;
D HD
;
W !
;
S L="",DIC="^ORD(101,",BY="[HL PROTOCOL MESSAGING FIELDS]"
S DIOEND="D EXPL^HLCSHDR4"
D EN1^DIP
;
Q
;
HD W @IOF,$$CJ^XLFSTR("HL7 Protocol Messaging Fields",IOM)
W !,$$REPEAT^XLFSTR("=",IOM)
W !,"This 'HL7 Protocol Messaging Fields' report holds information that will help"
W !,"you determine the effects from changes to routing-related fields in the MSH"
W !,"segment when messages are sent between or within VistA HL7 systems."
W !,"Additional explanation is included at the bottom of the report."
Q
;
EXPL N I,T QUIT:'$$EXPL1("Press RETURN for 'printout help', or '^' to exit... ") X "F I=1:1 S T=$T(EXPL+I) QUIT:T'["";;"" W !,$P(T,"";;"",2,99)" S I=$$EXPL1("Press RETURN to exit... ",1)
;;
;;When messages are received, their SENDING APPLICATION (MSH-3), MESSAGE
;;TYPE (MSH-9), EVENT TYPE (MSH-9), and HL7 VERSION (MSH-12) fields are used to
;;find the event driver protocol to be used in processing the just-received
;;message. After the event protocol is found, that protocol's subscriber
;;protocols are evaluated. The subscriber protocol with a RECEIVING
;;APPLICATION value that matches the RECEIVING APPLICATION field in the MSH
;;segment (MSH-5) is used.
;;
;;The first line for every "section" in the printout is the event driver
;;protocol. Lines preceded by dashes, are related subscriber protocols. An
;;example is shown below.
;;
;;Snd/Rec App's mTYP eTYP Ver Protocol Link
;;------------------------------------------------------------------------------
;;AC-VOICERAD ORU R01 2.3 | AC ORU SERVER
;;-AC-RADIOLOGY ORU R01 2.3 | AC ORU CLIENT NC TCP
;;
;;In this example, the 'AC-VOICERAD' line holds information for the 'AC ORU
;;SERVER' event protocol. And, the '-AC-RADIOLOGY' line holds information for
;;the 'AC ORU CLIENT' subscriber protocol.
Q
;
EXPL1(PMT,FF) ;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
QUIT:$E($G(IOST),1,2)'="C-" 1 ;->
F X=1:1:$G(FF) W !
S DIR(0)="EA",DIR("A")=PMT
D ^DIR
QUIT $S(Y=1:1,1:"")
;
M ; Covered by Integration Agreement #3988
; Application developers may call here when creating new messages,
; when experimenting with M code to evaluate and conditionally change
; routing-related fields.
;
; This API is called immediately before the MSH segment is created.
N IOINHI,IOINORM,MSHOLD,MSHNEW,MSHPRE,X
;
S X="IOINHI;IOINORM" D ENDR^%ZISS
;
S MSHOLD=$$MSHBUILD(0),MSHPRE=$$MSHBUILD(1)
W !!,"The original MSH segment is...",!!,IOINHI,MSHOLD,IOINORM
I MSHPRE'=MSHOLD D
. W !!,"The MSH segment, after modification by passed-in data, is..."
. W !!,IOINHI,MSHPRE,IOINORM
;
D MVAR("SENDING APPLICATION","HLMSHSAN","SERAPP")
D MVAR("SENDING FACILITY","HLMSHSFN","SERFAC")
D MVAR("RECEIVING APPLICATION","HLMSHRAN","CLNTAPP")
D MVAR("RECEIVING FACILITY","HLMSHRFN","CLNTFAC")
;
S MSHNEW=$$MSHBUILD
I MSHNEW'=MSHPRE D
. W !!,"Before your changes above, the modified MSH segment was..."
. W !!,IOINHI,MSHPRE,IOINORM
. W !!,"After your changes, the MSH segment is..."
. W !!,IOINHI,MSHNEW,IOINORM
W !!,$$REPEAT^XLFSTR("-",IOM)
W !!,"Message being sent..."
W !
;
Q
;
MVAR(FLD,VAR,VARO) ; Generic resetting of variable...
;IOINHI,IOINORM -- req
N ANS
W !!,?4,"Protocol-derived value of ",FLD,": "
W IOINHI,@VARO,IOINORM
W !,"Passed-in value of ",FLD," (",VAR,"): "
W IOINHI,@VAR,IOINORM
W !,?10,"Enter new value for ",FLD,": "
R ANS:60 Q:'$T ;->
I ANS[U!(ANS']"") D
. W !!,?10,"No changes will be made..."
I ANS'[U&(ANS]"") D
. S @VAR=ANS
. W !!,?10,"The variable ",IOINHI,VAR,IOINORM
. W " will be changed to '",IOINHI,ANS,IOINORM,"'."
. W !,?10,"This value will be stored in the ",FLD
. W !,?10,"field in the MSH segment..."
. W !!,$$REPEAT^XLFSTR("-",IOM)
Q
;
MSHBUILD(TYPE) ; Build MSH using current variables...
N MSH,PCE,RAN,RFN,SAN,SFN
S MSH="MSH"_FS_EC
I $G(TYPE)=0 F PCE=SERAPP,SERFAC,CLNTAPP,CLNTFAC,HLDATE,SECURITY,MSGTYPE,HLID,HLPID,$P(PROT,U,9),"",$G(^HL(772,TXTP,1)),ACCACK,APPACK,CNTRY D
. S MSH=MSH_FS_PCE
I $G(TYPE)'=0 D
. S SAN=HLMSHSAN,SAN=$S(SAN]"":SAN,1:SERAPP)
. S SFN=HLMSHSFN,SFN=$S(SFN]"":SFN,1:SERFAC)
. S RAN=HLMSHRAN,RAN=$S(RAN]"":RAN,1:CLNTAPP)
. S RFN=HLMSHRFN,RFN=$S(RFN]"":RFN,1:CLNTFAC)
. F PCE=SAN,SFN,RAN,RFN,HLDATE,SECURITY,MSGTYPE,HLID,HLPID,$P(PROT,U,9),"",$G(^HL(772,TXTP,1)),ACCACK,APPACK,CNTRY D
. . S MSH=MSH_FS_PCE
QUIT MSH
;
EOR ;HLCSHDR4 - Reset MSH Segment Fields ;9/12/02 11:50
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSHDR4 8884 printed Dec 13, 2024@01:56:36 Page 2
HLCSHDR4 ;SFIRMFO/LJA - Reset MSH Segment Fields ;10/09/2007 15:05
+1 ;;1.6;HEALTH LEVEL SEVEN;**93,108,122**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
DEBUG(STORE) ; If HLP set up for debugging, capture VIEW...
+1 ; HLMSH773 -- req
+2 ;
+3 NEW NOW,NUM,VAR,VARS,X,XTMP
+4 ;
+5 ; 1=some, 2=all
+6 ;->
SET STORE=$SELECT(STORE=1:1,STORE=2:2,1:0)
if 'STORE
QUIT
+7 ;
+8 SET NOW=$$NOW^XLFDT
+9 ;
+10 SET XTMP="HLCSHDR3 "_HLMSH773
+11 if '$DATA(^XTMP(XTMP,0))
SET ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,0,4)_U_NOW_U_"Debug data created by DEBUG~HLCSHDR4"
+12 ;
+13 SET NUM=$ORDER(^XTMP(XTMP,":"),-1)+1
+14 ;
+15 ; Grab only critical (some) variables?
+16 IF STORE=1
Begin DoDot:1
+17 +18 ; Sending information...
+19 SET ^XTMP(XTMP,NUM,"SA")=HLMSHSAO_U_HLSAN_U_HLMSHSAN
+20 SET ^XTMP(XTMP,NUM,"SF")=HLMSHSFO_U_HLSFN_U_HLMSHSFN
+21 +22 ; Receiving information...
+23 SET ^XTMP(XTMP,NUM,"RA")=HLMSHRAO_U_HLRAN_U_HLMSHRAN
+24 SET ^XTMP(XTMP,NUM,"RF")=HLMSHRFO_U_HLRFN_U_HLMSHRFN
+25 +26 ; Other information... (HLMSHPRE and HLMSHPRS hold 2 pieces!)
+27 SET ^XTMP(XTMP,NUM,0)=NOW_U_HLMSH772_U_HLMSHPRE_U_HLMSHPRS
+28 SET ^XTMP(XTMP,NUM,1)=HLMSHPRO
End DoDot:1
+29 ;
+30 ; Grab all variables?
+31 IF STORE=2
Begin DoDot:1
+32 SET X="^XTMP("""_XTMP_""","_NUM_","
+33 DO DOLRO^%ZOSV
End DoDot:1
+34 ;
+35 QUIT
+36 ;
SHOW NEW I773
+1 FOR
READ !!,"Enter 773 IEN: ",I773:60
if I773'>0
QUIT
Begin DoDot:1
+2 DO SHOW773(I773)
End DoDot:1
+3 QUIT
+4 ;
SHOW773(I773) ; Show Dynamic Routing MSH Field Reset Details
+1 NEW DIV,MSH,N90,N91
+2 ;
+3 SET N90=$GET(^HLMA(+I773,90))
SET N91=$GET(^HLMA(+I773,91))
+4 ;->
IF (N90_N91)']""
Begin DoDot:1
+5 WRITE " no debug data found..."
End DoDot:1
QUIT
+6 ;
+7 ;->
SET MSH=$GET(^HLMA(+I773,"MSH",1,0))
if MSH']""
QUIT
+8 SET DIV=$EXTRACT(MSH,4)
+9 ;
+10 WRITE !!,$$CJ^XLFSTR(" 773 # "_I773_" ",IOM,"=")
+11 ;
+12 DO HDR(90,N90)
+13 ;
+14 WRITE !
+15 DO HDR(91,N91)
+16 ;
+17 WRITE !!,$EXTRACT(MSH,1,IOM)
+18 ;
+19 SET C1=10
SET C2=30
SET C3=50
+20 WRITE !!,?C1,"Original (91)",?2,"Array (90)",?3,"MSH-Segment"
+21 WRITE !,$$REPEAT^XLFSTR("-",IOM)
+22 DO LINE("snd app",1,2,3)
+23 DO LINE("snd fac",3,3,4)
+24 DO LINE("rec app",5,4,5)
+25 DO LINE("rec fac",7,5,6)
+26 ;
+27 QUIT
+28 ;
LINE(HDR,PCE1,PCE2,PCE3) ; Print one comparison line...
+1 NEW P1,P2,P3,P4
+2 SET P1=$PIECE(N91,U,PCE1)
SET P2=$PIECE(N90,U,PCE2)
SET P3=$PIECE(MSH,DIV,PCE3)
SET P4=$PIECE(N91,U,PCE1+1)
+3 WRITE !,HDR,":",?C1,P1,?2,P2,?3,P3,$SELECT(P4]"":" ["_P4_"]",1:"")
+4 QUIT
+5 ;
HDR(NUM,DATA) NEW TXT
+1 SET TXT=$SELECT(NUM=90:"Array (90)",NUM=91:"Original (91)",1:"")
+2 WRITE !,$$CJ^XLFSTR("---------- "_TXT_" ----------",IOM)
+3 WRITE $$CJ^XLFSTR(DATA,IOM)
+4 QUIT
+5 ;
SET(NEW,VAR,PCE) ; This subroutine performs these actions:
+1 ; (1) Resets variables used in MSH segment
+2 ; (2) Resets SERAPP and CLNTAPP in ^HLMA(#,0)
+3 ; (3) Sets HLMSH91 nodes if overwrite occurs by ARRAY value.
+4 ; If overwrite occurs by M code, the overwrite has already
+5 ; been recorded in HLMSH91. (An overwrite produced by M code
+6 ; is never overwritten by ARRAY data.)
+7 ;
+8 NEW IEN771N,IEN771O,HLTCP
+9 ;
+10 ; VAR is the name of the variable, and not it's value...
+11 ; PRE is now the value of the VAR (pre-overwrite) variable...
SET PRE=@VAR
+12 ;
+13 ; Tests whether anything was changed...
+14 ;-> No new value exists to change to...
if NEW']""
QUIT
+15 ;-> New value = Original value. Nothing changed...
if NEW=PRE
QUIT
+16 ;
+17 ; THIS IS THE EPICENTER!! This is where the variables used in
+18 ; the MSH segment is overwritten.
+19 SET @VAR=NEW
+20 ;
+21 ; If PRE exists at this point, it was done by M code...
+22 ;->
if $PIECE(HLMSH91,U,PCE)]""
QUIT
+23 ;
+24 ; Change was made, but not by M code. Must be by array...
+25 SET $PIECE(HLMSH91,U,PCE)=PRE
SET $PIECE(HLMSH91,U,PCE+1)="A"
+26 ;
+27 ; patch HL*1.6*122: for "^" as component separater
+28 SET $PIECE(HLMSH91,U,PCE+2,999)=""
+29 ;
+30 ; Upgrade ^HLMA(#,0)...
+31 ;->
if PCE'=1&(PCE'=5)
QUIT
+32 ;
+33 ; patch HL*1.6*108 start
+34 ;S IEN771O=$O(^HL(771,"B",PRE,0)) QUIT:IEN771O'>0 ;-> Orig IEN
+35 ;S IEN771N=$O(^HL(771,"B",NEW,0)) QUIT:IEN771N'>0 ;-> New IEN
+36 ;-> Orig IEN
SET IEN771O=$ORDER(^HL(771,"B",$EXTRACT(PRE,1,30),0))
if IEN771O'>0
QUIT
+37 ;-> New IEN
SET IEN771N=$ORDER(^HL(771,"B",$EXTRACT(NEW,1,30),0))
if IEN771N'>0
QUIT
+38 ; patch HL*1.6*108 end
+39 ;
+40 ;->
if 'IEN771O!('IEN771N)!(IEN771O=IEN771N)
QUIT
+41 ; So 773 is updated...
SET HLTCP=1
+42 IF PCE=1
DO UPDATE^HLTF0(MTIENS,"","O","","",IEN771N)
+43 IF PCE=5
DO UPDATE^HLTF0(MTIENS,"","O","",IEN771N)
+44 ;
+45 QUIT
+46 ;
FIELDS ; Display the Protocol file fields used by the VistA HL7 package,
+1 ; when messages are received, to find the event and subscriber
+2 ; protocols.
+3 NEW BY,DIC,DIOEND,L
+4 ;
+5 DO HD
+6 ;
+7 WRITE !
+8 ;
+9 SET L=""
SET DIC="^ORD(101,"
SET BY="[HL PROTOCOL MESSAGING FIELDS]"
+10 SET DIOEND="D EXPL^HLCSHDR4"
+11 DO EN1^DIP
+12 ;
+13 QUIT
+14 ;
HD WRITE @IOF,$$CJ^XLFSTR("HL7 Protocol Messaging Fields",IOM)
+1 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+2 WRITE !,"This 'HL7 Protocol Messaging Fields' report holds information that will help"
+3 WRITE !,"you determine the effects from changes to routing-related fields in the MSH"
+4 WRITE !,"segment when messages are sent between or within VistA HL7 systems."
+5 WRITE !,"Additional explanation is included at the bottom of the report."
+6 QUIT
+7 ;
EXPL NEW I,T
if '$$EXPL1("Press RETURN for 'printout help', or '^' to exit... ")
QUIT
XECUTE "F I=1:1 S T=$T(EXPL+I) QUIT:T'["";;"" W !,$P(T,"";;"",2,99)"
SET I=$$EXPL1("Press RETURN to exit... ",1)
+1 ;;
+2 ;;When messages are received, their SENDING APPLICATION (MSH-3), MESSAGE
+3 ;;TYPE (MSH-9), EVENT TYPE (MSH-9), and HL7 VERSION (MSH-12) fields are used to
+4 ;;find the event driver protocol to be used in processing the just-received
+5 ;;message. After the event protocol is found, that protocol's subscriber
+6 ;;protocols are evaluated. The subscriber protocol with a RECEIVING
+7 ;;APPLICATION value that matches the RECEIVING APPLICATION field in the MSH
+8 ;;segment (MSH-5) is used.
+9 ;;
+10 ;;The first line for every "section" in the printout is the event driver
+11 ;;protocol. Lines preceded by dashes, are related subscriber protocols. An
+12 ;;example is shown below.
+13 ;;
+14 ;;Snd/Rec App's mTYP eTYP Ver Protocol Link
+15 ;;------------------------------------------------------------------------------
+16 ;;AC-VOICERAD ORU R01 2.3 | AC ORU SERVER
+17 ;;-AC-RADIOLOGY ORU R01 2.3 | AC ORU CLIENT NC TCP
+18 ;;
+19 ;;In this example, the 'AC-VOICERAD' line holds information for the 'AC ORU
+20 ;;SERVER' event protocol. And, the '-AC-RADIOLOGY' line holds information for
+21 ;;the 'AC ORU CLIENT' subscriber protocol.
+22 QUIT
+23 ;
EXPL1(PMT,FF) ;
+1 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+2 ;->
if $EXTRACT($GET(IOST),1,2)'="C-"
QUIT 1
+3 FOR X=1:1:$GET(FF)
WRITE !
+4 SET DIR(0)="EA"
SET DIR("A")=PMT
+5 DO ^DIR
+6 QUIT $SELECT(Y=1:1,1:"")
+7 ;
M ; Covered by Integration Agreement #3988
+1 ; Application developers may call here when creating new messages,
+2 ; when experimenting with M code to evaluate and conditionally change
+3 ; routing-related fields.
+4 ;
+5 ; This API is called immediately before the MSH segment is created.
+6 NEW IOINHI,IOINORM,MSHOLD,MSHNEW,MSHPRE,X
+7 ;
+8 SET X="IOINHI;IOINORM"
DO ENDR^%ZISS
+9 ;
+10 SET MSHOLD=$$MSHBUILD(0)
SET MSHPRE=$$MSHBUILD(1)
+11 WRITE !!,"The original MSH segment is...",!!,IOINHI,MSHOLD,IOINORM
+12 IF MSHPRE'=MSHOLD
Begin DoDot:1
+13 WRITE !!,"The MSH segment, after modification by passed-in data, is..."
+14 WRITE !!,IOINHI,MSHPRE,IOINORM
End DoDot:1
+15 ;
+16 DO MVAR("SENDING APPLICATION","HLMSHSAN","SERAPP")
+17 DO MVAR("SENDING FACILITY","HLMSHSFN","SERFAC")
+18 DO MVAR("RECEIVING APPLICATION","HLMSHRAN","CLNTAPP")
+19 DO MVAR("RECEIVING FACILITY","HLMSHRFN","CLNTFAC")
+20 ;
+21 SET MSHNEW=$$MSHBUILD
+22 IF MSHNEW'=MSHPRE
Begin DoDot:1
+23 WRITE !!,"Before your changes above, the modified MSH segment was..."
+24 WRITE !!,IOINHI,MSHPRE,IOINORM
+25 WRITE !!,"After your changes, the MSH segment is..."
+26 WRITE !!,IOINHI,MSHNEW,IOINORM
End DoDot:1
+27 WRITE !!,$$REPEAT^XLFSTR("-",IOM)
+28 WRITE !!,"Message being sent..."
+29 WRITE !
+30 ;
+31 QUIT
+32 ;
MVAR(FLD,VAR,VARO) ; Generic resetting of variable...
+1 ;IOINHI,IOINORM -- req
+2 NEW ANS
+3 WRITE !!,?4,"Protocol-derived value of ",FLD,": "
+4 WRITE IOINHI,@VARO,IOINORM
+5 WRITE !,"Passed-in value of ",FLD," (",VAR,"): "
+6 WRITE IOINHI,@VAR,IOINORM
+7 WRITE !,?10,"Enter new value for ",FLD,": "
+8 ;->
READ ANS:60
if '$TEST
QUIT
+9 IF ANS[U!(ANS']"")
Begin DoDot:1
+10 WRITE !!,?10,"No changes will be made..."
End DoDot:1
+11 IF ANS'[U&(ANS]"")
Begin DoDot:1
+12 SET @VAR=ANS
+13 WRITE !!,?10,"The variable ",IOINHI,VAR,IOINORM
+14 WRITE " will be changed to '",IOINHI,ANS,IOINORM,"'."
+15 WRITE !,?10,"This value will be stored in the ",FLD
+16 WRITE !,?10,"field in the MSH segment..."
+17 WRITE !!,$$REPEAT^XLFSTR("-",IOM)
End DoDot:1
+18 QUIT
+19 ;
MSHBUILD(TYPE) ; Build MSH using current variables...
+1 NEW MSH,PCE,RAN,RFN,SAN,SFN
+2 SET MSH="MSH"_FS_EC
+3 IF $GET(TYPE)=0
FOR PCE=SERAPP,SERFAC,CLNTAPP,CLNTFAC,HLDATE,SECURITY,MSGTYPE,HLID,HLPID,$PIECE(PROT,U,9),"",$GET(^HL(772,TXTP,1)),ACCACK,APPACK,CNTRY
Begin DoDot:1
+4 SET MSH=MSH_FS_PCE
End DoDot:1
+5 IF $GET(TYPE)'=0
Begin DoDot:1
+6 SET SAN=HLMSHSAN
SET SAN=$SELECT(SAN]"":SAN,1:SERAPP)
+7 SET SFN=HLMSHSFN
SET SFN=$SELECT(SFN]"":SFN,1:SERFAC)
+8 SET RAN=HLMSHRAN
SET RAN=$SELECT(RAN]"":RAN,1:CLNTAPP)
+9 SET RFN=HLMSHRFN
SET RFN=$SELECT(RFN]"":RFN,1:CLNTFAC)
+10 FOR PCE=SAN,SFN,RAN,RFN,HLDATE,SECURITY,MSGTYPE,HLID,HLPID,$PIECE(PROT,U,9),"",$GET(^HL(772,TXTP,1)),ACCACK,APPACK,CNTRY
Begin DoDot:2
+11 SET MSH=MSH_FS_PCE
End DoDot:2
End DoDot:1
+12 QUIT MSH
+13 ;
EOR ;HLCSHDR4 - Reset MSH Segment Fields ;9/12/02 11:50
