Produced by Araxis Merge on 9/25/2018 2:13:29 PM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | build 3.zip\build 3\MHLTH_YS_137_Source\MUMPS\RTN | YTQHL7.RTN | Thu Sep 6 11:30:06 2018 UTC |
2 | build 3.zip\build 3\MHLTH_YS_137_Source\MUMPS\RTN | YTQHL7.RTN | Wed Sep 12 18:11:21 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 314 |
Changed | 1 | 2 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | Cache for UNIX^INT^L oad Initia l Release MH VistA S ource^~For mat=Cache. S~^RAW | |
2 | %RO on 14 Mar 2017 6:10 PM | |
3 | YTQHL7^INT ^1^63910,7 4846^0 | |
4 | YTQHL7 ;AL B/ASF - HL 7 ; 3/9/12 1:06pm | |
5 | ;;5.01;ME NTAL HEALT H;**85,93, 97,106**;D ec 30, 199 4;Build 10 | |
6 | ;Referenc e to VADPT supported by IA #10 061 | |
7 | ;Referenc e to %ZTLO AD support ed by IA # 10063 | |
8 | ;Referenc e to XMD s upported b y IA #1007 0 | |
9 | ;Referenc e to HLCS2 supported by IA #28 87 | |
10 | ;Referenc e to HLFNC supported by IA #10 106 | |
11 | ;Referenc e to HLFNC 2 supporte d by IA #2 161 | |
12 | ;Referenc e to HLMA supported by IA #216 4 | |
13 | ;Referenc e to VAFHL PID suppor ted by IA #263 | |
14 | ;Referenc e to XLFNA ME support ed by IA # 3065 | |
15 | ;Referenc e to FILE 4 fields s upported b y DBIA #10 090 | |
16 | ;Referenc e to FILE 44 fields supported by DBIA #1 0040 | |
17 | Q | |
18 | ACKMHA ; | |
19 | N YSLOCAT ,YSERT,YSD IV,YSACK,Y SMID,YSFS, YSAD,YSMTX T,YSX,YS77 2,YSMSG | |
20 | S YSACK=" ",YSFS=HL( "FS") | |
21 | ;get ack type | |
22 | F X HLNE XT Q:HLQUI T'>0 D | |
23 | . I $P(HL NODE,YSFS) ="MSA" S Y SACK=$P(HL NODE,YSFS, 2),YSMID=$ P(HLNODE,Y SFS,3),YSE RT=$P(HLNO DE,YSFS,1, 4) | |
24 | ;get ien of 601.84 from messa ge | |
25 | S DIC=773 ,DIC(0)="M Z",X=YSMID D ^DIC K DIC | |
26 | I Y'>0 D ERRMAIL("B AD BAD") Q ;-->out | |
27 | S YS772=$ P(Y,U,2) ; ien of mes sage 772 | |
28 | S X=$$GET 1^DIQ(772, YS772_",", 200,,"YSMS G") | |
29 | S N=0,YSA D=0 F S N =$O(YSMSG( N)) Q:N'>0 !(YSAD>0) S YSOUT=Y SMSG(N) S: $P(YSOUT,Y SFS)="OBX" YSAD=+$P( YSOUT,YSFS ,4) | |
30 | I YSAD'>0 D ERRMAIL ("ERROR? MH ADMINIT RATION #60 1.84 ien i s 0",YSAD) Q ;--->o ut | |
31 | ;set 601. 84 fields | |
32 | S YSX=$S( YSACK="AA" :"S",YSACK ="AE":"E", YSACK="AR" :"E",1:"") | |
33 | S DA=YSAD ,DIE="^YTT (601.84,", DR="11///" _YSX_";12/ //NOW" D ^ DIE | |
34 | I YSACK=" AR" D ARSE ND Q ;res end HL7 an d --> out ASF 5/14/0 8 | |
35 | I YSX'="S " D ERRMAI L(YSERT,YS AD) | |
36 | Q | |
37 | ARSEND ;re send AR ac ks | |
38 | N ZTIO,ZT DESC,ZTRTN ,ZTREQ,ZTD TH | |
39 | S ZTSAVE( "YSAD")="" | |
40 | S ZTIO="" ,ZTRTN="AR HL7^YTQHL7 " | |
41 | S %DT="FR PS",X="NOW +1H" D ^%D T S ZTDTH= Y | |
42 | S ZTDESC= "mha3 AR H L7 resend of "_YSAD | |
43 | D ^%ZTLOA D | |
44 | Q | |
45 | ARHL7 ;tas kman hl7 r esend | |
46 | K YS,YSDA TA | |
47 | S YS("AD" )=YSAD | |
48 | D HL7^YTQ HL7(.YSDAT A,.YS) | |
49 | S ZTREQ=" @" | |
50 | Q | |
51 | ERRMAIL(X, YSAD) ;mai l error re ports | |
52 | N XMDUZ,X MSUB,XMTEX T,XMY,YSMA ILG | |
53 | S YSMAILG =$$GETAPP^ HLCS2("YS MHA") | |
54 | K ^TMP("Y SMHAHL7",$ J) | |
55 | S ^TMP("Y SMHAHL7",$ J,1,0)="An attempt t o send MHA 3 Administ ration ien #"_YSAD | |
56 | S ^TMP("Y SMHAHL7",$ J,2,0)="ge nerated an error." | |
57 | S ^TMP("Y SMHAHL7",$ J,3,0)="Er ror: "_X | |
58 | S ^TMP("Y SMHAHL7",$ J,4,0)="Pl ease repor t this err or mailto: hl7err@men talhealth. DNS " | |
59 | S XMSUB=" Mental Hea lth Assist ant 3 HL7 Error" | |
60 | S XMY("G. "_$P(YSMAI LG,U))="" | |
61 | S XMTEXT= "^TMP(""YS MHAHL7"",$ J," | |
62 | S XMDUZ=" AUTOMATED MESSAGE" | |
63 | D ^XMD | |
64 | K ^TMP("Y SMHAHL7",$ J) | |
65 | Q | |
66 | HL7(YSDATA ,YS) ;RPC entry | |
67 | ;input:AD MIN = ADMI NISTRATION # | |
68 | ;output: [DATA] | |
69 | N G,G1,N, YSAD,YSQ,C NT,MC,HLFS ,HLCS,DA,D FN,DIE,DR, HLECH,HLNE XT,HLNODE, HLQUIT,MYO PTNS,MYRES ULT,J1,J2 | |
70 | N VADMVT, VAINDT,X1, Y,YSANSID, YSAVED,YSC C,YSCONID, YSEQ,YSIN, YSIO,YSLIN E,YSORBY,Y SOUT,YSQN, YSTEST,YST ESTN,YSTS, YSTST,YSRT YP,YSRTYPN | |
71 | S YSDATA( 1)="[DATA] " Q ;ASF 10/13/11 S top all HL 7 messages | |
72 | S YSAD=$G (YS("AD")) | |
73 | I YSAD'?1 N.N S YSDA TA(1)="[ER ROR]",YSDA TA(2)="bad ad num" Q ;-->out | |
74 | I '$D(^YT T(601.84,Y SAD)) S YS DATA(1)="[ ERROR]",YS DATA(2)="n o such ref erence" Q ;-->out | |
75 | ;No Dups | |
76 | I $P($G(^ YTT(601.84 ,YSAD,2)), U)="S" S Y SDATA(1)=" [ERROR]",Y SDATA(2)=Y SAD_" is d up" Q ;-- >out | |
77 | S YSTST=$ P(^YTT(601 .84,YSAD,0 ),U,3) ;in s ien | |
78 | I $P($G(^ YTT(601.71 ,YSTST,8)) ,U,4)'="Y" S YSDATA( 1)="[DATA] ",YSDATA(2 )="ins not to be sen t" Q ;--> out | |
79 | S YSDATA( 1)="[ERROR ]" | |
80 | S DA=YSAD ,DIE="^YTT (601.84,", DR="11///T ;12///NOW" D ^DIE | |
81 | D ADSEND | |
82 | Q | |
83 | ADSEND ;se nd complet ed Admin t o MHSHG | |
84 | S DFN=$P( ^YTT(601.8 4,YSAD,0), U,2) | |
85 | S YSAVED= $P(^YTT(60 1.84,YSAD, 0),U,4) ;c hanged to GIVEN 10/3 1/07 | |
86 | S YSTESTN =$P(^YTT(6 01.84,YSAD ,0),U,3) | |
87 | S YSTEST= $$GET1^DIQ (601.71,YS TESTN_",", .01) | |
88 | S YSORBY= $P(^YTT(60 1.84,YSAD, 0),U,6) | |
89 | S YSLOCAT =$P(^YTT(6 01.84,YSAD ,0),U,11) | |
90 | S YSDIV=" " S:YSLOCA T?1N.N YSD IV=$$GET1^ DIQ(44,YSL OCAT_",",3 .5) | |
91 | I YSDIV=" "&($D(DUZ( 2))) S YSD IV=$$GET1^ DIQ(4,DUZ( 2)_",",.01 ) | |
92 | BLDM ;BUIL D A SINGLE MESSAGE | |
93 | ;MSH-EVN- PID-PV1-OB X | |
94 | K HLA,HLE VN | |
95 | N CNT,MC, HLFS,HLCS | |
96 | S CNT=0 | |
97 | 1 ;set up environmen t for mess age | |
98 | K HL D IN IT^HLFNC2( "YS MHA A0 8 EVENT",. HL) | |
99 | I $G(HL) D Q ; er ror occurr ed -->out | |
100 | . ; put e rror handl er here fo r init fai lure | |
101 | . S YSDAT A(1)="[ERR OR]",YSDAT A(2)="init Error: "_ $P(HL,2) W !,"XXX" | |
102 | S HLFS=$G (HL("FS")) I HLFS="" S HLFS="^ " | |
103 | S HLCS=$E (HL("ECH") ,1) | |
104 | 2 ;Add mes sage txt t o HLA arra y | |
105 | ;create E NV segment | |
106 | S CNT=CNT +1,HLA("HL S",CNT)="E VN"_HLFS_" A08"_HLFS_ $$HLDATE^H LFNC(YSAVE D,"TS")_HL FS_$$HLDAT E^HLFNC(YS AVED,"TS") _HLFS_"05" _HLFS_HLFS _$$HLDATE^ HLFNC(YSAV ED,"TS") | |
107 | ; create PID segmen t for pati ent DFN -- call segm ent genera tor | |
108 | S CNT=CNT +1,HLA("HL S",CNT)=$$ EN^VAFHLPI D(DFN,"1,2 ,4,6,7,8,1 0,11,12,13 ,16,17,19, 22",1,1) | |
109 | ;create P V1 segment | |
110 | S VAINDT= YSAVED D A DM^VADPT2 S YSIO=$S( VADMVT>0:" I",1:"O") | |
111 | S CNT=CNT +1,HLA("HL S",CNT)="P V1"_HLFS_" 0001"_HLFS _YSIO_HLFS _"~~~~~~~~ "_YSDIV | |
112 | ;create O BX segment s | |
113 | D OBX(YSA D) | |
114 | ;crete PR 1 proccedu re | |
115 | S CNT=CNT +1 | |
116 | S HLA("HL S",CNT)="P R1"_HLFS_1 _HLFS_HLFS _YSTESTN_$ E($G(HLECH ))_YSTEST_ HLFS_HLFS_ $$HLDATE^H LFNC(YSAVE D,"TS")_HL FS_"D" | |
117 | N DGNAME S DGNAME(" FILE")=200 ,DGNAME("I ENS")=YSOR BY,DGNAME( "FIELD")=. 01 | |
118 | S X1=$$HL NAME^XLFNA ME(.DGNAME ,"S",$E($G (HLECH))), X1=YSORBY_ $E(HLECH,1 )_X1 | |
119 | S HLA("HL S",CNT)=HL A("HLS",CN T)_HLFS_HL FS_HLFS_HL FS_HLFS_HL FS_X1 | |
120 | CTRL ;remo ve stray c hars | |
121 | F J1=1:1: CNT D:$G(H LA("HLS",J 1))?.E1C.E CTRL1 | |
122 | ; | |
123 | DIRECT ;CA LL HL7 TO TRANSMIT M ESSAGE | |
124 | D GENERAT E^HLMA("YS MHA A08 E VENT","LM" ,1,.MYRESU LT,"",.MYO PTNS) | |
125 | S YSDATA( 1)="[DATA] " | |
126 | Q | |
127 | OBX(YSAD) ;enter mul tiple OBX seqments | |
128 | S YSIN=$P (^YTT(601. 84,YSAD,0) ,U,3) | |
129 | S YSEQ=0 F S YSEQ= $O(^YTT(60 1.76,"AD", YSIN,YSEQ) ) Q:YSEQ'> 0 S YSCON ID=$O(^YTT (601.76,"A D",YSIN,YS EQ,0)) D | |
130 | . S YSQN= $P(^YTT(60 1.76,YSCON ID,0),U,4) | |
131 | . S YSRTY P=$P($G(^Y TT(601.72, YSQN,2)),U ,2) | |
132 | . S YSRTY PN=YSRTYP* (-1) | |
133 | . S YSANS ID=$O(^YTT (601.85,"A C",YSAD,YS QN,0)) | |
134 | . Q:YSANS ID'?1N.N | |
135 | . S G=$G( ^YTT(601.8 5,YSANSID, 0)),YSCC=$ P(G,U,4) | |
136 | . S CNT=C NT+1 | |
137 | . I +YSCC S CNT=CNT +1,HLA("HL S",CNT)="O BX"_HLFS_Y SEQ_HLFS_" CE"_HLFS_Y SAD_"~~~"_ YSQN_HLFS_ 1_HLFS_YSC C_"~"_$G(^ YTT(601.75 ,$P(G,U,4) ,1))_"|||| ||"_"R|||" _$$HLDATE^ HLFNC(YSAV ED,"TS") Q | |
138 | . E S YS LINE=0 F S YSLINE=$ O(^YTT(601 .85,YSANSI D,1,YSLINE )) Q:YSLIN E'>0 D | |
139 | .. S CNT= CNT+1,HLA( "HLS",CNT) ="OBX"_HLF S_YSEQ_HLF S_"CE"_HLF S_YSAD_"~~ ~"_YSQN_HL FS_YSLINE_ HLFS_YSRTY PN_"~" | |
140 | .. S Y1=$ G(^YTT(601 .85,YSANSI D,1,YSLINE ,0)) | |
141 | .. F X1=" |","~" S X =$S(X1="~" :":;",1:"; :") F %=0: 0 S %=$F(Y 1,X1,%) Q: %<2 S Y1= $E(Y1,1,%- $L(X1)-1)_ X_$E(Y1,%, 999) | |
142 | .. S HLA( "HLS",CNT) =HLA("HLS" ,CNT)_Y1_" ||||||"_"R |||"_$$HLD ATE^HLFNC( YSAVED,"TS ") Q | |
143 | Q | |
144 | REDO ;rese nd all no transmits and errors | |
145 | S YSAD=0 F S YSAD= $O(^YTT(60 1.84,YSAD) ) Q:YSAD'> 0 D | |
146 | . S YSTS= $P($G(^YTT (601.84,YS AD,2)),U) | |
147 | . I (YSTS ="T")!(YST S="E") K Y S,YSDATA S YS("AD")= YSAD D HL7 (.YSDATA,. YS) | |
148 | Q | |
149 | REDO1 ;res end single admin | |
150 | K DIC,DIR S DIC(0)= "AEQM",DIC ="^YTT(601 .84," D ^D IC Q:Y'>0 ;-->out | |
151 | W ! | |
152 | S (YSAD,D A)=+Y D EN ^DIQ | |
153 | S DIR(0)= "Y",DIR("A ")="Send H L7",DIR("B ")="No" D ^DIR | |
154 | I Y K YS, YSDATA S Y S("AD")=YS AD D HL7(. YSDATA,.YS ) | |
155 | G REDO1 | |
156 | CTRL1 ;rem ove contro l chars | |
157 | F J2=1:1 Q:HLA("HLS ",J1)'?.E1 C.E S:$E( HLA("HLS", J1),J2)?1C HLA("HLS" ,J1)=$E(HL A("HLS",J1 ),0,J2-1)_ $E(HLA("HL S",J1),J2+ 1,999),J2= J2-1 | |
158 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.