Produced by Araxis Merge on 9/24/2019 1:38:08 PM Eastern 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 | PCL-5_v1_build_8.zip\v1_build 8\Unredacted\spp_mha_web-development.zip\spp_mha_web-development\MUMPS\RTN | YTQHL7.RTN | Wed Jul 31 17:35:31 2019 UTC |
| 2 | PCL-5_v1_build_8.zip\v1_build 8\Unredacted\spp_mha_web-development.zip\spp_mha_web-development\MUMPS\RTN | YTQHL7.RTN | Mon Sep 23 17:14:03 2019 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: URL " | |
| 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.