Index: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR4.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR4.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR4.m	(revision 623)
@@ -1,257 +1,253 @@
-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
+HLCSHDR4 ;SFIRMFO/LJA - Reset MSH Segment Fields ;3/24/2004 14:27
+ ;;1.6;HEALTH LEVEL SEVEN;**93,108**;Oct 13, 1995
+ ;
+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"
+ ;
+ ; 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
