source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGDHW0.m@ 1569

Last change on this file since 1569 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1MAGDHW0 ;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 ;
20INIT ;
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 ;
38FINDSEG(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 ;
54SAVESEG(I,X) ; save updated segment
55 S $P(HL7(I),DEL,2,999)=X
56 Q
57 ;
58ADDSEG(X) ; add a new segment to the end of the message
59 S HL7($O(HL7(""),-1)+1)=X
60 Q
61 ;
62OUTPUT ; 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 ;
Note: See TracBrowser for help on using the repository browser.