source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLTRANS.m@ 812

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