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

HLTRANS.m

Go to the documentation of this file.
  1. HLTRANS ;AISC/SAW-Create Mail Message and Entry in the HL7 Transmission File ;03/24/2004 16:22
  1. ;;1.6;HEALTH LEVEL SEVEN;**108**;Oct 13, 1995
  1. ;This routine is used for the Version 1.5 Interface Only
  1. EN ;Compile 'MSH' Segment
  1. 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
  1. EN1 ;Create Mail Message (Package Supplies MSH Segment(s))
  1. S XMSUB="HL7 Message "_HLDT_" from "_HLDAN_" at Station "_$P(HLNDAP0,"^",2),XMDUZ=.5 D GET^XMA2 G EN1:XMZ<1 S HLXMZ=XMZ
  1. I '$D(HLERR1) N X,Y D
  1. .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)
  1. ..I $E(X,1,3)="MSA" S HLMSA=X
  1. ..I $E(X,1,3)="BHS",$P(X,HLFS,10)]"" S HLMSA=$P(X,HLFS,10)
  1. .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)
  1. ..I $E(X,1,3)="MSA" S HLMSA=X
  1. ..I $E(X,1,3)="BHS",$P(X,HLFS,10)]"" S HLMSA=$P(X,HLFS,10)
  1. .S HLI0=HLI0-1,^XMB(3.9,HLXMZ,2,0)="^3.92A^"_HLI0_"^"_HLI0_"^"_DT,XMDUN="POSTMASTER"
  1. .I $P(HLNDAP0,"^",10) D
  1. ..S X=$G(^XMB(3.8,$P(HLNDAP0,"^",10),0)) I $P(X,"^")]"" S XMY("G."_$P(X,"^"))=""
  1. ..E K XMY S HLERR1=1,HLERR="Unable to determine receipients for mail message.",XMY(.5)="" K ^XMB(3.9,HLXMZ,2)
  1. .I '$P(HLNDAP0,"^",10) S XMY(.5)=""
  1. .I '$D(HLERR1) D ENT1^XMD
  1. EN2 ;Enter Data into HL7 Transmission File/Record Error Messages
  1. S:$D(HLERR) HLMSG="Application Error" D OUT^HLTF(HLDA,HLDT,HLMTN) I $D(HLERR1) D
  1. .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
  1. .S XMY(.5)="" D ENT1^XMD
  1. EXIT K HLERR1,HLI,HLI0,HLMSA,HLXMZ,VAT,VATERR,VATNAME,XMDUN,XMDUZ,XMSUB,XMY,XMZ Q
  1. INIT ;Initialize Variables for Creating HL7 Segments
  1. ;The following variables are returned by this entry point:
  1. ;HLNDAP - Non-DHCP Application Pointer from file 770
  1. ;HLNDAP0 - Zero node from file 770 corresponding to HLNDAP
  1. ;HLDAP - DHCP Application Pointer from file 771
  1. ;HLDAN - The DHCP Application Name (.01 field, file 771) for HLDAP
  1. ;HLPID - HL7 processing ID from file 770
  1. ;HLVER - HL7 version number from file 770
  1. ;HLFS - HL7 Field Separater from the 'FS' node of file 771
  1. ;HLECH - HL7 Encoding Characters from the 'EC' node of file 771
  1. ;HLQ - Double quotes ("") for use in building HL7 segments
  1. ;HLERR - if an error is encountered, an error message is returned
  1. ; in the HLERR variable.
  1. ;HLDA - the internal entry number for the entry created in file 772.
  1. ;HLDT - the transmission date/time (associated with the entry in
  1. ; in file 772 identified by HLDA) in internal VA FileMan
  1. ; format.
  1. ;HLDT1 - the same transmission date/time as the HLDT variable, only
  1. ; in HL7 format.
  1. ;
  1. ; patch HL*1.6*108 start
  1. ;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
  1. 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
  1. ; patch HL*1.6*108 end
  1. ;
  1. 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
  1. S HLNDAP0=$S($D(^HL(770,HLNDAP,0)):^(0),1:"") I HLNDAP0']"" S HLERR="Invalid Non-DHCP Application Name" G SET
  1. I '$D(HLDAP) S HLDAP=$P(HLNDAP0,"^",8) I 'HLDAP S HLERR="Invalid DHCP Application Name" G SET
  1. I '$D(HLDAN) S HLDAN=$S($D(^HL(771,HLDAP,0)):$P(^(0),"^"),1:"") I HLDAN']"" S HLERR="Invalid DHCP Application Name" G SET
  1. S HLPID=$P(HLNDAP0,"^",14) I HLPID']"" S HLPID="P"
  1. S HLVER=$S($D(^HL(771.5,+$P(HLNDAP0,"^",7),0)):$P(^(0),"^"),1:2.1) I HLVER']"" S HLVER=2.1
  1. S HLQ="""""",HLFS=$S($D(^HL(771,HLDAP,"FS")):$E(^("FS")),1:"^"),HLECH=$S($D(^("EC")):$E(^("EC"),1,4),1:"~|\&")
  1. SET D CREATE^HLTF(.HLMID,.HLDA,.HLDT,.HLDT1) K HLMID
  1. 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
  1. Q
  1. KILL ;Delete HL variables created by calls to INIT^HLTRANS and FILE^HLTF
  1. K HLCHAR,HLDA,HLDAN,HLDAP,HLDT,HLDT1,HLDUZ,HLECH,HLERR,HLFS,HLNDAP,HLNDAP0,HLPID,HLQ,HLVER Q