| 1 | MAGDHL7 ;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 | ;
|
|---|
| 29 | ENTRY ; 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 | ;
|
|---|
| 58 | EN ; 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 | ;
|
|---|
| 63 | EN2 ;
|
|---|
| 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...
|
|---|
| 78 | UPDATE ; 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 | ;
|
|---|
| 95 | ADDDTA(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 | ;
|
|---|
| 135 | NEWMSG(DATE) ; Add a stub for a new message
|
|---|
| 136 | N D0,HDR
|
|---|
| 137 | S DATE=DATE\1
|
|---|
| 138 | L +^MAGDHL7(2006.5,0):1E9 ; Background process MUST wait
|
|---|
| 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 | ;
|
|---|
