source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGDHL7.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA

File size: 6.1 KB
RevLine 
[628]1MAGDHL7 ;WOIFO/PMK,MLH - Routine to copy HL7 data from HLSDATA to ^MAGDHL7 ; 02/07/2007 14:07
2 ;;3.0;IMAGING;**11,30,86**;20-February-2007;;Build 1024
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ;Steps for setting up the HL7 package. Version 1.5
20 ;1) Create an entry in the HL7 APPLICATION PARAMETER file (771) called
21 ; 'PACS GATEWAY' and set ACTIVE/INACTIVE field to ACTIVE.
22 ;2) Create an entry in the HL7 NON-DHCP APPLICATION PARAMETER file (770)
23 ; called 'PACS GATEWAY' and set DHCP APPLICATION field to 'PACS GATEWAY'
24 ; (repoint to file 771).
25 ;3) Set the Entry Action field of the RA SEND entry in the Protocol file
26 ; (101) to call 'PACS GATEWAY
27 ; EXAMPLE: Replace xxxx With PACS GATEWAY
28 ;
29ENTRY ; Entry point for HL7 1.5 version
30 N DA,EDT,DIK,DIR,HLSDT,KDT,MAGN,MAGOUT,POP
31 ; Entry point from ^HLTRANS to copy the data from HLSDATA to ^MAGDHL7(
32 ; This code was reset due to a max. string code error. Peter indicated
33 ; he did not need the 5th piece of the OBR segment.
34 I $D(HLSDATA(3)),$P(HLSDATA(3),"^")="OBR" S $P(HLSDATA(3),"^",5)=""
35 D ADDDTA($NA(HLSDATA))
36 ; Adjust the returned HLSDATA array to start at 0 instead of 1
37 S IX=1
38 F Q:'IX Q:'$D(HLSDATA(IX)) D
39 . S HLSDATA(IX-1)=HLSDATA(IX) K HLSDATA(IX)
40 . S IX=$O(HLSDATA(IX))
41 . Q
42 Q:$D(HLSDT)
43 D NOW^%DTC S Y=$$NEWMSG($P(%,".",1))
44 S $P(^MAGDHL7(2006.5,+Y,0),"^",2)=$P(HLSDATA(0),"^",9) ; Message type
45 S L=1,J=0 S ^MAGDHL7(2006.5,+Y,1,L,0)=HLSDATA(0)
46 F S J=$O(HLSDATA(J)) Q:J'>0 D
47 . S L=L+1,^MAGDHL7(2006.5,+Y,1,L,0)=HLSDATA(J)
48 . Q
49 S ^MAGDHL7(2006.5,+Y,1,0)="^^"_L_U_L_U_DT
50 ; Capture time
51 S X=$P($G(^MAGDHL7(2006.5,+Y,0)),"^",3)
52 K:X ^MAGDHL7(2006.5,"C",X,+Y)
53 S X=$$NOW^XLFDT()
54 S $P(^MAGDHL7(2006.5,+Y,0),"^",3)=X
55 S ^MAGDHL7(2006.5,"C",X,+Y)=""
56 Q
57 ;
58EN ; Entry point for HL7 1.6. Called from the MAG SEND ORU/ORM protocols.
59 ; Executed after the RA protocols setup the HL7 message segments.
60 D EN2
61 Q
62 ;
63EN2 ;
64 N DA,DIE,DIC,DR,I,J,K,L,MAGRAD,MAGRAN,MAGSAN,MAGTYPE,Y,X
65 I $D(HLQUIT),HLQUIT Q ; HL7 routines may have failed.
66 S MAGRAD=""
67 F I=1:1 X HLNEXT Q:HLQUIT'>0 D
68 . S MAGRAD(I)=HLNODE,J=0
69 . F S J=$O(HLNODE(J)) Q:'J S MAGRAD(I)=MAGRAD(I)_HLNODE(J)
70 . Q
71 ; Above code needed for segments greater than 245 characters.
72 S MAGTYPE=$G(HL("MTN")),MAGRAN=$G(HL("RAN")),MAGSAN=$G(HL("SAN"))
73 ; Add demo and modality info expected by MAGDHR* routines on gateway
74 D ADDDTA($NA(MAGRAD))
75 ; Fall-Through intentional
76 ; EdM: I can find no evidence that the label below is invoked from anywhere
77 ; in the released code...
78UPDATE ; Add the entry in the MAGDHL7(2006.5 global.
79 D NOW^%DTC S Y=$$NEWMSG($P(%,".",1))
80 I +Y<1 Q ; Entry not made in file.
81 S $P(^MAGDHL7(2006.5,+Y,0),"^",2)=MAGTYPE
82 ; Add HL7 message into word processing field.
83 S (L,K)=0 F S K=$O(MAGRAD(K)) Q:'K S L=L+1,^MAGDHL7(2006.5,+Y,1,L,0)=MAGRAD(K) D
84 . ; If segment has more than one line of data, add as a single line
85 . ; Peter's code will take care of this.
86 . S J=0 F S J=$O(MAGRAD(K,J)) Q:'J S L=L+1,^MAGDHL7(2006.5,+Y,1,L,0)=MAGRAD(K,J)
87 S ^MAGDHL7(2006.5,+Y,1,0)="^2006.502^"_L_"^"_L_"^"_DT
88 S X=$P($G(^MAGDHL7(2006.5,+Y,0)),"^",3)
89 K:X ^MAGDHL7(2006.5,"C",X,+Y)
90 S X=$$NOW^XLFDT
91 S $P(^MAGDHL7(2006.5,+Y,0),"^",3)=X
92 S ^MAGDHL7(2006.5,"C",X,+Y)=""
93 Q
94 ;
95ADDDTA(XARY) ; SUBROUTINE - called by ENTRY, EN2
96 ; Add demographic, visit, and modality information to HL7 messages.
97 ;
98 ; input: XARY name of array into which additional HL7 message data is to
99 ; be populated (@XARY should already contain HL7 msg segments)
100 ; valued "MAGRAD" for radiology orders
101 ; "HLSDATA" for ADT messages
102 ;
103 ; output: @XARY with demo, visit, modality segments added
104 ; or NTE segment added after MSH if there was a problem
105 ;
106 ; The DICOM gateway's MAGDHR* routines formerly expected to be able to use
107 ; a DDP link to gather supplementary information about patient demographics
108 ; and modality. This subroutine populates the HL7 segments with the
109 ; supplementary data, eliminating the need for the DDP link.
110 ;
111 N MAG7WRK ; -- work array for HL7 message
112 N STSRBLD ; -- rebuild status
113 N S1,S2 ; ---- scratch segment index vars
114 ;
115 ; Break out message -- If parse fails, insert a NTE segment and bail
116 ;
117 I $$PARSE^MAG7UP(XARY,$NA(MAG7WRK)) D Q
118 . ; Set 1st, 2nd seg indices - don't overwrite bare MSH
119 . S S1=$O(@XARY@(0)) S:'S1 S1=1
120 . S S2=$O(@XARY@(S1)) S:'S2 S2=S1+1
121 . S @XARY@((S1+S2)/2)="NTE|1||bad HL7 message structure"
122 . Q
123 D PIDADD^MAG7RS ; Add patient demographic data
124 D ADDVSDG^MAG7RS ; Add patient visit and diagnosis data
125 I MAG7WRK(1,9,1,1,1)="ORU" D OBXUPD^MAG7RSO ; Add numeric diag codes
126 S STSRBLD=$$MAKE^MAG7UM($NA(MAG7WRK),XARY)
127 I STSRBLD D Q
128 . ; Set 1st, 2nd seg indices - don't overwrite bare MSH
129 . S S1=$O(@XARY@(0)) S:'S1 S1=1
130 . S S2=$O(@XARY@(S1)) S:'S2 S2=S1+1
131 . S @XARY@((S1+S2)/2)="NTE|1||bad HL7 message structure"
132 . Q
133 Q
134 ;
135NEWMSG(DATE) ; Add a stub for a new message
136 N D0,HDR
137 S DATE=DATE\1
[636]138 L +^MAGDHL7(2006.5,0):19 ; Background process MUST wait
[628]139 S D0=$O(^MAGDHL7(2006.5," "),-1)+1
140 S ^MAGDHL7(2006.5,D0,0)=DATE
141 S:DATE'="" ^MAGDHL7(2006.5,"B",DATE,D0)=""
142 S HDR=$G(^MAGDHL7(2006.5,0))
143 S ^MAGDHL7(2006.5,0)="PACS MESSAGE^2006.5D^"_D0_"^"_($P(HDR,"^",4)+1)
144 L -^MAGDHL7(2006.5,0)
145 Q D0
146 ;
Note: See TracBrowser for help on using the repository browser.