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

HLCSHDR4.m

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