| [613] | 1 | MAGDHW0 ;WOIFO/PMK - Capture Consult/Request data ; 02/07/2007 06:37
|
|---|
| 2 | ;;3.0;IMAGING;**10,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 | ;
|
|---|
| 20 | INIT ;
|
|---|
| 21 | ; simulate call to INT^HLFNC2
|
|---|
| 22 | N I
|
|---|
| 23 | S HL("CC")="US"
|
|---|
| 24 | S HL("ECH")="^~\&"
|
|---|
| 25 | S HL("ETN")=""
|
|---|
| 26 | S HL("FS")="|"
|
|---|
| 27 | S HL("MTN")="ORM"
|
|---|
| 28 | S HL("PID")="D"
|
|---|
| 29 | S HL("Q")=""
|
|---|
| 30 | S HL("SAF")=^DD("SITE",1)
|
|---|
| 31 | S HL("SAN")="MAGD-SCH"
|
|---|
| 32 | S HL("VER")="2.3.1"
|
|---|
| 33 | S DEL=HL("FS")
|
|---|
| 34 | F I=1:1:$L(HL("ECH")) S @("DEL"_(I+1))=$E(HL("ECH"),I)
|
|---|
| 35 | S U="^"
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | FINDSEG(ARRAY,SEGMENT,I,X) ; find a specific HL7 segment in an array
|
|---|
| 39 | ; input -- ARRAY ---- an HL7 array
|
|---|
| 40 | ; input -- SEGMENT -- three-letter HL7 segment identifier
|
|---|
| 41 | ; input -- I -------- index of the found segment (or null)
|
|---|
| 42 | ; output - I -------- index of the found segment (or null)
|
|---|
| 43 | ; output - X -------- string of fields sans segment identifier
|
|---|
| 44 | ; return - HIT ------ flag indicating segment found
|
|---|
| 45 | ;
|
|---|
| 46 | N HIT
|
|---|
| 47 | S HIT=0
|
|---|
| 48 | F S I=$O(ARRAY(I)) Q:I="" I $P(ARRAY(I),DEL)=SEGMENT D Q
|
|---|
| 49 | . S X=$P(ARRAY(I),DEL,2,99999) ; strip off the segment name
|
|---|
| 50 | . S HIT=1
|
|---|
| 51 | . Q
|
|---|
| 52 | Q HIT
|
|---|
| 53 | ;
|
|---|
| 54 | SAVESEG(I,X) ; save updated segment
|
|---|
| 55 | S $P(HL7(I),DEL,2,999)=X
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ADDSEG(X) ; add a new segment to the end of the message
|
|---|
| 59 | S HL7($O(HL7(""),-1)+1)=X
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | OUTPUT ; output the message to ^MAGDHL7
|
|---|
| 63 | N DIC,DIE,D0,DA,DR,I,J,K,X,Y,Z
|
|---|
| 64 | S D0=$$NEWMSG^MAGDHL7(FMDATE)
|
|---|
| 65 | ; Capture time
|
|---|
| 66 | S X=$P($G(^MAGDHL7(2006.5,D0,0)),"^",3)
|
|---|
| 67 | K:X ^MAGDHL7(2006.5,"C",X,D0)
|
|---|
| 68 | S:'$G(FMDATETM) FMDATETM=$$NOW^XLFDT()
|
|---|
| 69 | S $P(^MAGDHL7(2006.5,D0,0),"^",3)=FMDATETM
|
|---|
| 70 | S ^MAGDHL7(2006.5,"C",FMDATETM,D0)=""
|
|---|
| 71 | ;
|
|---|
| 72 | S $P(^MAGDHL7(2006.5,D0,0),"^",2)="ORM" ; all are ORM
|
|---|
| 73 | S I="HL7",J=0 F S I=$Q(@I) Q:I="" D
|
|---|
| 74 | . S X=@I,Y=$P(X,DEL)
|
|---|
| 75 | . F K=2:1:$L(X,DEL) D ; copy the lines to the ^MAGDHL7 global
|
|---|
| 76 | . . S Z=$P(X,DEL,K)
|
|---|
| 77 | . . I ($L(Y)+$L(Z))>200 D ; keep lines short for the global
|
|---|
| 78 | . . . ; output one line of a spanned record
|
|---|
| 79 | . . . S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y,Y=""
|
|---|
| 80 | . . . Q
|
|---|
| 81 | . . S Y=Y_DEL_$P(X,DEL,K)
|
|---|
| 82 | . . Q
|
|---|
| 83 | . S J=J+1,^MAGDHL7(2006.5,D0,1,J,0)=Y
|
|---|
| 84 | . Q
|
|---|
| 85 | ; The next line must be last, since WAIT^MAGDHRS1
|
|---|
| 86 | ; uses this node to determine that the entry is complete.
|
|---|
| 87 | S ^MAGDHL7(2006.5,D0,1,0)="^2006.502^"_J_"^"_J_"^"_FMDATETM
|
|---|
| 88 | Q
|
|---|
| 89 | ;
|
|---|
