source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLTRANS.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1HLTRANS ;AISC/SAW-Create Mail Message and Entry in the HL7 Transmission File ;03/24/2004 16:22
2 ;;1.6;HEALTH LEVEL SEVEN;**108**;Oct 13, 1995
3 ;This routine is used for the Version 1.5 Interface Only
4EN ;Compile 'MSH' Segment
5 I '$D(HLERR1) S HLEVN=1,HLSDATA(0)=$$MSH^HLFNC1($G(HLMTN),$G(HLSEC)) I $D(HLSDT) S ^TMP("HLS",$J,HLSDT,0)=HLSDATA(0) K HLSDATA
6EN1 ;Create Mail Message (Package Supplies MSH Segment(s))
7 S XMSUB="HL7 Message "_HLDT_" from "_HLDAN_" at Station "_$P(HLNDAP0,"^",2),XMDUZ=.5 D GET^XMA2 G EN1:XMZ<1 S HLXMZ=XMZ
8 I '$D(HLERR1) N X,Y D
9 .I '$D(HLSDT) S HLI="",HLCHAR=0 F HLI0=1:1 S HLI=$O(HLSDATA(HLI)) Q:HLI="" S ^XMB(3.9,HLXMZ,2,HLI0,0)=HLSDATA(HLI),HLCHAR=HLCHAR+$L(HLSDATA(HLI)) S X=HLSDATA(HLI) I $E(X,1,3)="MSA"!($E(X,1,3)="BHS") D:'$D(HLMSA)
10 ..I $E(X,1,3)="MSA" S HLMSA=X
11 ..I $E(X,1,3)="BHS",$P(X,HLFS,10)]"" S HLMSA=$P(X,HLFS,10)
12 .I $D(HLSDT) S HLI="",HLCHAR=0 F HLI0=1:1 S HLI=$O(^TMP("HLS",$J,HLSDT,HLI)) Q:HLI="" S X=^TMP("HLS",$J,HLSDT,HLI),^XMB(3.9,HLXMZ,2,HLI0,0)=X,HLCHAR=HLCHAR+$L(X) I $E(X,1,3)="MSA"!($E(X,1,3)="BHS") D:'$D(HLMSA)
13 ..I $E(X,1,3)="MSA" S HLMSA=X
14 ..I $E(X,1,3)="BHS",$P(X,HLFS,10)]"" S HLMSA=$P(X,HLFS,10)
15 .S HLI0=HLI0-1,^XMB(3.9,HLXMZ,2,0)="^3.92A^"_HLI0_"^"_HLI0_"^"_DT,XMDUN="POSTMASTER"
16 .I $P(HLNDAP0,"^",10) D
17 ..S X=$G(^XMB(3.8,$P(HLNDAP0,"^",10),0)) I $P(X,"^")]"" S XMY("G."_$P(X,"^"))=""
18 ..E K XMY S HLERR1=1,HLERR="Unable to determine receipients for mail message.",XMY(.5)="" K ^XMB(3.9,HLXMZ,2)
19 .I '$P(HLNDAP0,"^",10) S XMY(.5)=""
20 .I '$D(HLERR1) D ENT1^XMD
21EN2 ;Enter Data into HL7 Transmission File/Record Error Messages
22 S:$D(HLERR) HLMSG="Application Error" D OUT^HLTF(HLDA,HLDT,HLMTN) I $D(HLERR1) D
23 .S ^XMB(3.9,HLXMZ,2,1,0)="Unable to transmit HL7 message due to the following Application Error:",^XMB(3.9,HLXMZ,2,2,0)=HLERR,^XMB(3.9,HLXMZ,2,0)="^3.92A^2^2^"_DT
24 .S XMY(.5)="" D ENT1^XMD
25EXIT K HLERR1,HLI,HLI0,HLMSA,HLXMZ,VAT,VATERR,VATNAME,XMDUN,XMDUZ,XMSUB,XMY,XMZ Q
26INIT ;Initialize Variables for Creating HL7 Segments
27 ;The following variables are returned by this entry point:
28 ;HLNDAP - Non-DHCP Application Pointer from file 770
29 ;HLNDAP0 - Zero node from file 770 corresponding to HLNDAP
30 ;HLDAP - DHCP Application Pointer from file 771
31 ;HLDAN - The DHCP Application Name (.01 field, file 771) for HLDAP
32 ;HLPID - HL7 processing ID from file 770
33 ;HLVER - HL7 version number from file 770
34 ;HLFS - HL7 Field Separater from the 'FS' node of file 771
35 ;HLECH - HL7 Encoding Characters from the 'EC' node of file 771
36 ;HLQ - Double quotes ("") for use in building HL7 segments
37 ;HLERR - if an error is encountered, an error message is returned
38 ; in the HLERR variable.
39 ;HLDA - the internal entry number for the entry created in file 772.
40 ;HLDT - the transmission date/time (associated with the entry in
41 ; in file 772 identified by HLDA) in internal VA FileMan
42 ; format.
43 ;HLDT1 - the same transmission date/time as the HLDT variable, only
44 ; in HL7 format.
45 ;
46 ; patch HL*1.6*108 start
47 ;I $D(HLDAP) S:'HLDAP HLDAN=HLDAP S HLDAP=$S('HLDAP:$O(^HL(771,"B",HLDAP,0)),1:HLDAP),HLNDAP=$O(^HL(770,"AG",+HLDAP,0)) I 'HLDAP!('HLNDAP) S HLERR="Invalid "_$S('HLDAP:"DHCP",1:"Non-DHCP")_" Application Name" G SET
48 I $D(HLDAP) S:'HLDAP HLDAN=HLDAP S HLDAP=$S('HLDAP:$O(^HL(771,"B",$E(HLDAP,1,30),0)),1:HLDAP),HLNDAP=$O(^HL(770,"AG",+HLDAP,0)) I 'HLDAP!('HLNDAP) S HLERR="Invalid "_$S('HLDAP:"DHCP",1:"Non-DHCP")_" Application Name" G SET
49 ; patch HL*1.6*108 end
50 ;
51 S HLNDAP=$S('$D(HLNDAP):0,HLNDAP:HLNDAP,1:$O(^HL(770,"B",HLNDAP,0))) I 'HLNDAP S HLERR="Invalid Non-DHCP Application Name" G SET
52 S HLNDAP0=$S($D(^HL(770,HLNDAP,0)):^(0),1:"") I HLNDAP0']"" S HLERR="Invalid Non-DHCP Application Name" G SET
53 I '$D(HLDAP) S HLDAP=$P(HLNDAP0,"^",8) I 'HLDAP S HLERR="Invalid DHCP Application Name" G SET
54 I '$D(HLDAN) S HLDAN=$S($D(^HL(771,HLDAP,0)):$P(^(0),"^"),1:"") I HLDAN']"" S HLERR="Invalid DHCP Application Name" G SET
55 S HLPID=$P(HLNDAP0,"^",14) I HLPID']"" S HLPID="P"
56 S HLVER=$S($D(^HL(771.5,+$P(HLNDAP0,"^",7),0)):$P(^(0),"^"),1:2.1) I HLVER']"" S HLVER=2.1
57 S HLQ="""""",HLFS=$S($D(^HL(771,HLDAP,"FS")):$E(^("FS")),1:"^"),HLECH=$S($D(^("EC")):$E(^("EC"),1,4),1:"~|\&")
58SET D CREATE^HLTF(.HLMID,.HLDA,.HLDT,.HLDT1) K HLMID
59 I $D(HLERR) S:'$G(HLDAP) HLDAP="" S:'HLNDAP HLNDAP="" S:$G(HLDAN)']"" HLDAN="UNKNOWN" S:'$G(HLNDAP0) HLNDAP0="^UNKNOWN" S HLMTN="UNKNOWN",HLERR1=1,HLFS="" D EN K HLFS,HLMSG,HLMTN
60 Q
61KILL ;Delete HL variables created by calls to INIT^HLTRANS and FILE^HLTF
62 K HLCHAR,HLDA,HLDAN,HLDAP,HLDT,HLDT1,HLDUZ,HLECH,HLERR,HLFS,HLNDAP,HLNDAP0,HLPID,HLQ,HLVER Q
Note: See TracBrowser for help on using the repository browser.