254 lines
8.3 KiB
Mathematica
254 lines
8.3 KiB
Mathematica
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
|