Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR4.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLCSHDR4.m
r613 r623 1 HLCSHDR4 ;SFIRMFO/LJA - Reset MSH Segment Fields ;10/09/2007 15:05 2 ;;1.6;HEALTH LEVEL SEVEN;**93,108,122**;Oct 13, 1995;Build 14 3 ;Per VHA Directive 2004-038, this routine should not be modified 4 ; 5 DEBUG(STORE) ; If HLP set up for debugging, capture VIEW... 6 ; HLMSH773 -- req 7 ; 8 N NOW,NUM,VAR,VARS,X,XTMP 9 ; 10 ; 1=some, 2=all 11 S STORE=$S(STORE=1:1,STORE=2:2,1:0) QUIT:'STORE ;-> 12 ; 13 S NOW=$$NOW^XLFDT 14 ; 15 S XTMP="HLCSHDR3 "_HLMSH773 16 S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,0,4)_U_NOW_U_"Debug data created by DEBUG~HLCSHDR4" 17 ; 18 S NUM=$O(^XTMP(XTMP,":"),-1)+1 19 ; 20 ; Grab only critical (some) variables? 21 I STORE=1 D 22 . 23 . ; Sending information... 24 . S ^XTMP(XTMP,NUM,"SA")=HLMSHSAO_U_HLSAN_U_HLMSHSAN 25 . S ^XTMP(XTMP,NUM,"SF")=HLMSHSFO_U_HLSFN_U_HLMSHSFN 26 . 27 . ; Receiving information... 28 . S ^XTMP(XTMP,NUM,"RA")=HLMSHRAO_U_HLRAN_U_HLMSHRAN 29 . S ^XTMP(XTMP,NUM,"RF")=HLMSHRFO_U_HLRFN_U_HLMSHRFN 30 . 31 . ; Other information... (HLMSHPRE and HLMSHPRS hold 2 pieces!) 32 . S ^XTMP(XTMP,NUM,0)=NOW_U_HLMSH772_U_HLMSHPRE_U_HLMSHPRS 33 . S ^XTMP(XTMP,NUM,1)=HLMSHPRO 34 ; 35 ; Grab all variables? 36 I STORE=2 D 37 . S X="^XTMP("""_XTMP_""","_NUM_"," 38 . D DOLRO^%ZOSV 39 ; 40 QUIT 41 ; 42 SHOW N I773 43 F R !!,"Enter 773 IEN: ",I773:60 Q:I773'>0 D 44 . D SHOW773(I773) 45 QUIT 46 ; 47 SHOW773(I773) ; Show Dynamic Routing MSH Field Reset Details 48 N DIV,MSH,N90,N91 49 ; 50 S N90=$G(^HLMA(+I773,90)),N91=$G(^HLMA(+I773,91)) 51 I (N90_N91)']"" D QUIT ;-> 52 . W " no debug data found..." 53 ; 54 S MSH=$G(^HLMA(+I773,"MSH",1,0)) QUIT:MSH']"" ;-> 55 S DIV=$E(MSH,4) 56 ; 57 W !!,$$CJ^XLFSTR(" 773 # "_I773_" ",IOM,"=") 58 ; 59 D HDR(90,N90) 60 ; 61 W ! 62 D HDR(91,N91) 63 ; 64 W !!,$E(MSH,1,IOM) 65 ; 66 S C1=10,C2=30,C3=50 67 W !!,?C1,"Original (91)",?2,"Array (90)",?3,"MSH-Segment" 68 W !,$$REPEAT^XLFSTR("-",IOM) 69 D LINE("snd app",1,2,3) 70 D LINE("snd fac",3,3,4) 71 D LINE("rec app",5,4,5) 72 D LINE("rec fac",7,5,6) 73 ; 74 QUIT 75 ; 76 LINE(HDR,PCE1,PCE2,PCE3) ; Print one comparison line... 77 N P1,P2,P3,P4 78 S P1=$P(N91,U,PCE1),P2=$P(N90,U,PCE2),P3=$P(MSH,DIV,PCE3),P4=$P(N91,U,PCE1+1) 79 W !,HDR,":",?C1,P1,?2,P2,?3,P3,$S(P4]"":" ["_P4_"]",1:"") 80 QUIT 81 ; 82 HDR(NUM,DATA) N TXT 83 S TXT=$S(NUM=90:"Array (90)",NUM=91:"Original (91)",1:"") 84 W !,$$CJ^XLFSTR("---------- "_TXT_" ----------",IOM) 85 W $$CJ^XLFSTR(DATA,IOM) 86 QUIT 87 ; 88 SET(NEW,VAR,PCE) ; This subroutine performs these actions: 89 ; (1) Resets variables used in MSH segment 90 ; (2) Resets SERAPP and CLNTAPP in ^HLMA(#,0) 91 ; (3) Sets HLMSH91 nodes if overwrite occurs by ARRAY value. 92 ; If overwrite occurs by M code, the overwrite has already 93 ; been recorded in HLMSH91. (An overwrite produced by M code 94 ; is never overwritten by ARRAY data.) 95 ; 96 N IEN771N,IEN771O,HLTCP 97 ; 98 ; VAR is the name of the variable, and not it's value... 99 S PRE=@VAR ; PRE is now the value of the VAR (pre-overwrite) variable... 100 ; 101 ; Tests whether anything was changed... 102 QUIT:NEW']"" ;-> No new value exists to change to... 103 QUIT:NEW=PRE ;-> New value = Original value. Nothing changed... 104 ; 105 ; THIS IS THE EPICENTER!! This is where the variables used in 106 ; the MSH segment is overwritten. 107 S @VAR=NEW 108 ; 109 ; If PRE exists at this point, it was done by M code... 110 QUIT:$P(HLMSH91,U,PCE)]"" ;-> 111 ; 112 ; Change was made, but not by M code. Must be by array... 113 S $P(HLMSH91,U,PCE)=PRE,$P(HLMSH91,U,PCE+1)="A" 114 ; 115 ; patch HL*1.6*122: for "^" as component separater 116 S $P(HLMSH91,U,PCE+2,999)="" 117 ; 118 ; Upgrade ^HLMA(#,0)... 119 QUIT:PCE'=1&(PCE'=5) ;-> 120 ; 121 ; patch HL*1.6*108 start 122 ;S IEN771O=$O(^HL(771,"B",PRE,0)) QUIT:IEN771O'>0 ;-> Orig IEN 123 ;S IEN771N=$O(^HL(771,"B",NEW,0)) QUIT:IEN771N'>0 ;-> New IEN 124 S IEN771O=$O(^HL(771,"B",$E(PRE,1,30),0)) QUIT:IEN771O'>0 ;-> Orig IEN 125 S IEN771N=$O(^HL(771,"B",$E(NEW,1,30),0)) QUIT:IEN771N'>0 ;-> New IEN 126 ; patch HL*1.6*108 end 127 ; 128 QUIT:'IEN771O!('IEN771N)!(IEN771O=IEN771N) ;-> 129 S HLTCP=1 ; So 773 is updated... 130 I PCE=1 D UPDATE^HLTF0(MTIENS,"","O","","",IEN771N) 131 I PCE=5 D UPDATE^HLTF0(MTIENS,"","O","",IEN771N) 132 ; 133 QUIT 134 ; 135 FIELDS ; Display the Protocol file fields used by the VistA HL7 package, 136 ; when messages are received, to find the event and subscriber 137 ; protocols. 138 N BY,DIC,DIOEND,L 139 ; 140 D HD 141 ; 142 W ! 143 ; 144 S L="",DIC="^ORD(101,",BY="[HL PROTOCOL MESSAGING FIELDS]" 145 S DIOEND="D EXPL^HLCSHDR4" 146 D EN1^DIP 147 ; 148 Q 149 ; 150 HD W @IOF,$$CJ^XLFSTR("HL7 Protocol Messaging Fields",IOM) 151 W !,$$REPEAT^XLFSTR("=",IOM) 152 W !,"This 'HL7 Protocol Messaging Fields' report holds information that will help" 153 W !,"you determine the effects from changes to routing-related fields in the MSH" 154 W !,"segment when messages are sent between or within VistA HL7 systems." 155 W !,"Additional explanation is included at the bottom of the report." 156 Q 157 ; 158 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) 159 ;; 160 ;;When messages are received, their SENDING APPLICATION (MSH-3), MESSAGE 161 ;;TYPE (MSH-9), EVENT TYPE (MSH-9), and HL7 VERSION (MSH-12) fields are used to 162 ;;find the event driver protocol to be used in processing the just-received 163 ;;message. After the event protocol is found, that protocol's subscriber 164 ;;protocols are evaluated. The subscriber protocol with a RECEIVING 165 ;;APPLICATION value that matches the RECEIVING APPLICATION field in the MSH 166 ;;segment (MSH-5) is used. 167 ;; 168 ;;The first line for every "section" in the printout is the event driver 169 ;;protocol. Lines preceded by dashes, are related subscriber protocols. An 170 ;;example is shown below. 171 ;; 172 ;;Snd/Rec App's mTYP eTYP Ver Protocol Link 173 ;;------------------------------------------------------------------------------ 174 ;;AC-VOICERAD ORU R01 2.3 | AC ORU SERVER 175 ;;-AC-RADIOLOGY ORU R01 2.3 | AC ORU CLIENT NC TCP 176 ;; 177 ;;In this example, the 'AC-VOICERAD' line holds information for the 'AC ORU 178 ;;SERVER' event protocol. And, the '-AC-RADIOLOGY' line holds information for 179 ;;the 'AC ORU CLIENT' subscriber protocol. 180 Q 181 ; 182 EXPL1(PMT,FF) ; 183 N DIR,DIRUT,DTOUT,DUOUT,X,Y 184 QUIT:$E($G(IOST),1,2)'="C-" 1 ;-> 185 F X=1:1:$G(FF) W ! 186 S DIR(0)="EA",DIR("A")=PMT 187 D ^DIR 188 QUIT $S(Y=1:1,1:"") 189 ; 190 M ; Covered by Integration Agreement #3988 191 ; Application developers may call here when creating new messages, 192 ; when experimenting with M code to evaluate and conditionally change 193 ; routing-related fields. 194 ; 195 ; This API is called immediately before the MSH segment is created. 196 N IOINHI,IOINORM,MSHOLD,MSHNEW,MSHPRE,X 197 ; 198 S X="IOINHI;IOINORM" D ENDR^%ZISS 199 ; 200 S MSHOLD=$$MSHBUILD(0),MSHPRE=$$MSHBUILD(1) 201 W !!,"The original MSH segment is...",!!,IOINHI,MSHOLD,IOINORM 202 I MSHPRE'=MSHOLD D 203 . W !!,"The MSH segment, after modification by passed-in data, is..." 204 . W !!,IOINHI,MSHPRE,IOINORM 205 ; 206 D MVAR("SENDING APPLICATION","HLMSHSAN","SERAPP") 207 D MVAR("SENDING FACILITY","HLMSHSFN","SERFAC") 208 D MVAR("RECEIVING APPLICATION","HLMSHRAN","CLNTAPP") 209 D MVAR("RECEIVING FACILITY","HLMSHRFN","CLNTFAC") 210 ; 211 S MSHNEW=$$MSHBUILD 212 I MSHNEW'=MSHPRE D 213 . W !!,"Before your changes above, the modified MSH segment was..." 214 . W !!,IOINHI,MSHPRE,IOINORM 215 . W !!,"After your changes, the MSH segment is..." 216 . W !!,IOINHI,MSHNEW,IOINORM 217 W !!,$$REPEAT^XLFSTR("-",IOM) 218 W !!,"Message being sent..." 219 W ! 220 ; 221 Q 222 ; 223 MVAR(FLD,VAR,VARO) ; Generic resetting of variable... 224 ;IOINHI,IOINORM -- req 225 N ANS 226 W !!,?4,"Protocol-derived value of ",FLD,": " 227 W IOINHI,@VARO,IOINORM 228 W !,"Passed-in value of ",FLD," (",VAR,"): " 229 W IOINHI,@VAR,IOINORM 230 W !,?10,"Enter new value for ",FLD,": " 231 R ANS:60 Q:'$T ;-> 232 I ANS[U!(ANS']"") D 233 . W !!,?10,"No changes will be made..." 234 I ANS'[U&(ANS]"") D 235 . S @VAR=ANS 236 . W !!,?10,"The variable ",IOINHI,VAR,IOINORM 237 . W " will be changed to '",IOINHI,ANS,IOINORM,"'." 238 . W !,?10,"This value will be stored in the ",FLD 239 . W !,?10,"field in the MSH segment..." 240 . W !!,$$REPEAT^XLFSTR("-",IOM) 241 Q 242 ; 243 MSHBUILD(TYPE) ; Build MSH using current variables... 244 N MSH,PCE,RAN,RFN,SAN,SFN 245 S MSH="MSH"_FS_EC 246 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 247 . S MSH=MSH_FS_PCE 248 I $G(TYPE)'=0 D 249 . S SAN=HLMSHSAN,SAN=$S(SAN]"":SAN,1:SERAPP) 250 . S SFN=HLMSHSFN,SFN=$S(SFN]"":SFN,1:SERFAC) 251 . S RAN=HLMSHRAN,RAN=$S(RAN]"":RAN,1:CLNTAPP) 252 . S RFN=HLMSHRFN,RFN=$S(RFN]"":RFN,1:CLNTFAC) 253 . F PCE=SAN,SFN,RAN,RFN,HLDATE,SECURITY,MSGTYPE,HLID,HLPID,$P(PROT,U,9),"",$G(^HL(772,TXTP,1)),ACCACK,APPACK,CNTRY D 254 . . S MSH=MSH_FS_PCE 255 QUIT MSH 256 ; 257 EOR ;HLCSHDR4 - Reset MSH Segment Fields ;9/12/02 11:50 1 HLCSHDR4 ;SFIRMFO/LJA - Reset MSH Segment Fields ;3/24/2004 14:27 2 ;;1.6;HEALTH LEVEL SEVEN;**93,108**;Oct 13, 1995 3 ; 4 DEBUG(STORE) ; If HLP set up for debugging, capture VIEW... 5 ; HLMSH773 -- req 6 ; 7 N NOW,NUM,VAR,VARS,X,XTMP 8 ; 9 ; 1=some, 2=all 10 S STORE=$S(STORE=1:1,STORE=2:2,1:0) QUIT:'STORE ;-> 11 ; 12 S NOW=$$NOW^XLFDT 13 ; 14 S XTMP="HLCSHDR3 "_HLMSH773 15 S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,0,4)_U_NOW_U_"Debug data created by DEBUG~HLCSHDR4" 16 ; 17 S NUM=$O(^XTMP(XTMP,":"),-1)+1 18 ; 19 ; Grab only critical (some) variables? 20 I STORE=1 D 21 . 22 . ; Sending information... 23 . S ^XTMP(XTMP,NUM,"SA")=HLMSHSAO_U_HLSAN_U_HLMSHSAN 24 . S ^XTMP(XTMP,NUM,"SF")=HLMSHSFO_U_HLSFN_U_HLMSHSFN 25 . 26 . ; Receiving information... 27 . S ^XTMP(XTMP,NUM,"RA")=HLMSHRAO_U_HLRAN_U_HLMSHRAN 28 . S ^XTMP(XTMP,NUM,"RF")=HLMSHRFO_U_HLRFN_U_HLMSHRFN 29 . 30 . ; Other information... (HLMSHPRE and HLMSHPRS hold 2 pieces!) 31 . S ^XTMP(XTMP,NUM,0)=NOW_U_HLMSH772_U_HLMSHPRE_U_HLMSHPRS 32 . S ^XTMP(XTMP,NUM,1)=HLMSHPRO 33 ; 34 ; Grab all variables? 35 I STORE=2 D 36 . S X="^XTMP("""_XTMP_""","_NUM_"," 37 . D DOLRO^%ZOSV 38 ; 39 QUIT 40 ; 41 SHOW N I773 42 F R !!,"Enter 773 IEN: ",I773:60 Q:I773'>0 D 43 . D SHOW773(I773) 44 QUIT 45 ; 46 SHOW773(I773) ; Show Dynamic Routing MSH Field Reset Details 47 N DIV,MSH,N90,N91 48 ; 49 S N90=$G(^HLMA(+I773,90)),N91=$G(^HLMA(+I773,91)) 50 I (N90_N91)']"" D QUIT ;-> 51 . W " no debug data found..." 52 ; 53 S MSH=$G(^HLMA(+I773,"MSH",1,0)) QUIT:MSH']"" ;-> 54 S DIV=$E(MSH,4) 55 ; 56 W !!,$$CJ^XLFSTR(" 773 # "_I773_" ",IOM,"=") 57 ; 58 D HDR(90,N90) 59 ; 60 W ! 61 D HDR(91,N91) 62 ; 63 W !!,$E(MSH,1,IOM) 64 ; 65 S C1=10,C2=30,C3=50 66 W !!,?C1,"Original (91)",?2,"Array (90)",?3,"MSH-Segment" 67 W !,$$REPEAT^XLFSTR("-",IOM) 68 D LINE("snd app",1,2,3) 69 D LINE("snd fac",3,3,4) 70 D LINE("rec app",5,4,5) 71 D LINE("rec fac",7,5,6) 72 ; 73 QUIT 74 ; 75 LINE(HDR,PCE1,PCE2,PCE3) ; Print one comparison line... 76 N P1,P2,P3,P4 77 S P1=$P(N91,U,PCE1),P2=$P(N90,U,PCE2),P3=$P(MSH,DIV,PCE3),P4=$P(N91,U,PCE1+1) 78 W !,HDR,":",?C1,P1,?2,P2,?3,P3,$S(P4]"":" ["_P4_"]",1:"") 79 QUIT 80 ; 81 HDR(NUM,DATA) N TXT 82 S TXT=$S(NUM=90:"Array (90)",NUM=91:"Original (91)",1:"") 83 W !,$$CJ^XLFSTR("---------- "_TXT_" ----------",IOM) 84 W $$CJ^XLFSTR(DATA,IOM) 85 QUIT 86 ; 87 SET(NEW,VAR,PCE) ; This subroutine performs these actions: 88 ; (1) Resets variables used in MSH segment 89 ; (2) Resets SERAPP and CLNTAPP in ^HLMA(#,0) 90 ; (3) Sets HLMSH91 nodes if overwrite occurs by ARRAY value. 91 ; If overwrite occurs by M code, the overwrite has already 92 ; been recorded in HLMSH91. (An overwrite produced by M code 93 ; is never overwritten by ARRAY data.) 94 ; 95 N IEN771N,IEN771O,HLTCP 96 ; 97 ; VAR is the name of the variable, and not it's value... 98 S PRE=@VAR ; PRE is now the value of the VAR (pre-overwrite) variable... 99 ; 100 ; Tests whether anything was changed... 101 QUIT:NEW']"" ;-> No new value exists to change to... 102 QUIT:NEW=PRE ;-> New value = Original value. Nothing changed... 103 ; 104 ; THIS IS THE EPICENTER!! This is where the variables used in 105 ; the MSH segment is overwritten. 106 S @VAR=NEW 107 ; 108 ; If PRE exists at this point, it was done by M code... 109 QUIT:$P(HLMSH91,U,PCE)]"" ;-> 110 ; 111 ; Change was made, but not by M code. Must be by array... 112 S $P(HLMSH91,U,PCE)=PRE,$P(HLMSH91,U,PCE+1)="A" 113 ; 114 ; Upgrade ^HLMA(#,0)... 115 QUIT:PCE'=1&(PCE'=5) ;-> 116 ; 117 ; patch HL*1.6*108 start 118 ;S IEN771O=$O(^HL(771,"B",PRE,0)) QUIT:IEN771O'>0 ;-> Orig IEN 119 ;S IEN771N=$O(^HL(771,"B",NEW,0)) QUIT:IEN771N'>0 ;-> New IEN 120 S IEN771O=$O(^HL(771,"B",$E(PRE,1,30),0)) QUIT:IEN771O'>0 ;-> Orig IEN 121 S IEN771N=$O(^HL(771,"B",$E(NEW,1,30),0)) QUIT:IEN771N'>0 ;-> New IEN 122 ; patch HL*1.6*108 end 123 ; 124 QUIT:'IEN771O!('IEN771N)!(IEN771O=IEN771N) ;-> 125 S HLTCP=1 ; So 773 is updated... 126 I PCE=1 D UPDATE^HLTF0(MTIENS,"","O","","",IEN771N) 127 I PCE=5 D UPDATE^HLTF0(MTIENS,"","O","",IEN771N) 128 ; 129 QUIT 130 ; 131 FIELDS ; Display the Protocol file fields used by the VistA HL7 package, 132 ; when messages are received, to find the event and subscriber 133 ; protocols. 134 N BY,DIC,DIOEND,L 135 ; 136 D HD 137 ; 138 W ! 139 ; 140 S L="",DIC="^ORD(101,",BY="[HL PROTOCOL MESSAGING FIELDS]" 141 S DIOEND="D EXPL^HLCSHDR4" 142 D EN1^DIP 143 ; 144 Q 145 ; 146 HD W @IOF,$$CJ^XLFSTR("HL7 Protocol Messaging Fields",IOM) 147 W !,$$REPEAT^XLFSTR("=",IOM) 148 W !,"This 'HL7 Protocol Messaging Fields' report holds information that will help" 149 W !,"you determine the effects from changes to routing-related fields in the MSH" 150 W !,"segment when messages are sent between or within VistA HL7 systems." 151 W !,"Additional explanation is included at the bottom of the report." 152 Q 153 ; 154 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) 155 ;; 156 ;;When messages are received, their SENDING APPLICATION (MSH-3), MESSAGE 157 ;;TYPE (MSH-9), EVENT TYPE (MSH-9), and HL7 VERSION (MSH-12) fields are used to 158 ;;find the event driver protocol to be used in processing the just-received 159 ;;message. After the event protocol is found, that protocol's subscriber 160 ;;protocols are evaluated. The subscriber protocol with a RECEIVING 161 ;;APPLICATION value that matches the RECEIVING APPLICATION field in the MSH 162 ;;segment (MSH-5) is used. 163 ;; 164 ;;The first line for every "section" in the printout is the event driver 165 ;;protocol. Lines preceded by dashes, are related subscriber protocols. An 166 ;;example is shown below. 167 ;; 168 ;;Snd/Rec App's mTYP eTYP Ver Protocol Link 169 ;;------------------------------------------------------------------------------ 170 ;;AC-VOICERAD ORU R01 2.3 | AC ORU SERVER 171 ;;-AC-RADIOLOGY ORU R01 2.3 | AC ORU CLIENT NC TCP 172 ;; 173 ;;In this example, the 'AC-VOICERAD' line holds information for the 'AC ORU 174 ;;SERVER' event protocol. And, the '-AC-RADIOLOGY' line holds information for 175 ;;the 'AC ORU CLIENT' subscriber protocol. 176 Q 177 ; 178 EXPL1(PMT,FF) ; 179 N DIR,DIRUT,DTOUT,DUOUT,X,Y 180 QUIT:$E($G(IOST),1,2)'="C-" 1 ;-> 181 F X=1:1:$G(FF) W ! 182 S DIR(0)="EA",DIR("A")=PMT 183 D ^DIR 184 QUIT $S(Y=1:1,1:"") 185 ; 186 M ; Covered by Integration Agreement #3988 187 ; Application developers may call here when creating new messages, 188 ; when experimenting with M code to evaluate and conditionally change 189 ; routing-related fields. 190 ; 191 ; This API is called immediately before the MSH segment is created. 192 N IOINHI,IOINORM,MSHOLD,MSHNEW,MSHPRE,X 193 ; 194 S X="IOINHI;IOINORM" D ENDR^%ZISS 195 ; 196 S MSHOLD=$$MSHBUILD(0),MSHPRE=$$MSHBUILD(1) 197 W !!,"The original MSH segment is...",!!,IOINHI,MSHOLD,IOINORM 198 I MSHPRE'=MSHOLD D 199 . W !!,"The MSH segment, after modification by passed-in data, is..." 200 . W !!,IOINHI,MSHPRE,IOINORM 201 ; 202 D MVAR("SENDING APPLICATION","HLMSHSAN","SERAPP") 203 D MVAR("SENDING FACILITY","HLMSHSFN","SERFAC") 204 D MVAR("RECEIVING APPLICATION","HLMSHRAN","CLNTAPP") 205 D MVAR("RECEIVING FACILITY","HLMSHRFN","CLNTFAC") 206 ; 207 S MSHNEW=$$MSHBUILD 208 I MSHNEW'=MSHPRE D 209 . W !!,"Before your changes above, the modified MSH segment was..." 210 . W !!,IOINHI,MSHPRE,IOINORM 211 . W !!,"After your changes, the MSH segment is..." 212 . W !!,IOINHI,MSHNEW,IOINORM 213 W !!,$$REPEAT^XLFSTR("-",IOM) 214 W !!,"Message being sent..." 215 W ! 216 ; 217 Q 218 ; 219 MVAR(FLD,VAR,VARO) ; Generic resetting of variable... 220 ;IOINHI,IOINORM -- req 221 N ANS 222 W !!,?4,"Protocol-derived value of ",FLD,": " 223 W IOINHI,@VARO,IOINORM 224 W !,"Passed-in value of ",FLD," (",VAR,"): " 225 W IOINHI,@VAR,IOINORM 226 W !,?10,"Enter new value for ",FLD,": " 227 R ANS:60 Q:'$T ;-> 228 I ANS[U!(ANS']"") D 229 . W !!,?10,"No changes will be made..." 230 I ANS'[U&(ANS]"") D 231 . S @VAR=ANS 232 . W !!,?10,"The variable ",IOINHI,VAR,IOINORM 233 . W " will be changed to '",IOINHI,ANS,IOINORM,"'." 234 . W !,?10,"This value will be stored in the ",FLD 235 . W !,?10,"field in the MSH segment..." 236 . W !!,$$REPEAT^XLFSTR("-",IOM) 237 Q 238 ; 239 MSHBUILD(TYPE) ; Build MSH using current variables... 240 N MSH,PCE,RAN,RFN,SAN,SFN 241 S MSH="MSH"_FS_EC 242 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 243 . S MSH=MSH_FS_PCE 244 I $G(TYPE)'=0 D 245 . S SAN=HLMSHSAN,SAN=$S(SAN]"":SAN,1:SERAPP) 246 . S SFN=HLMSHSFN,SFN=$S(SFN]"":SFN,1:SERFAC) 247 . S RAN=HLMSHRAN,RAN=$S(RAN]"":RAN,1:CLNTAPP) 248 . S RFN=HLMSHRFN,RFN=$S(RFN]"":RFN,1:CLNTFAC) 249 . F PCE=SAN,SFN,RAN,RFN,HLDATE,SECURITY,MSGTYPE,HLID,HLPID,$P(PROT,U,9),"",$G(^HL(772,TXTP,1)),ACCACK,APPACK,CNTRY D 250 . . S MSH=MSH_FS_PCE 251 QUIT MSH 252 ; 253 EOR ;HLCSHDR4 - Reset MSH Segment Fields ;9/12/02 11:50
Note:
See TracChangeset
for help on using the changeset viewer.
