source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAG7UM.m@ 1394

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

initial load of WorldVistAEHR
File size: 5.4 KB
Line 
1MAG7UM ;WOIFO/MLH - Imaging - HL7 - utilities - make a message from a parse tree
2 ;;3.0;IMAGING;**11**;14-April-2004
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
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 ;
19 Q
20 ;
21MAKE(XTREE,XMSG) ; make a parse tree into an array of message lines
22 ;
23 ; INPUT: XTREE The name of the parse tree ($NA format)
24 ; Parse tree structure:
25 ; @XTREE@(NSEG,0) segment name
26 ; @XTREE@(NSEG,NFLD,NREP,NCMP,NSCM) element data
27 ; @XTREE@("B",SEGID,NSEG) null
28 ;
29 ; XMSG The name of a single-dimensional array to be populated
30 ; with message lines ($NA format). This array is
31 ; cleared on invocation.
32 ;
33 ; OUTPUT: XMSG The array after being populated with message lines
34 ;
35 N UFS,UCS,URS,UEC,USS ;---------------- HL7 delimiters (universal)
36 N X,I ; --------------------------------- scratch var
37 N ERR ; ------------------------------- error flag
38 N ENC ; ------------------------------- encoding characters string
39 N NSEG ; ------------------------------ segment number in the parse tree
40 N NMSEG ; ----------------------------- segment number in the message
41 N IMSG ; ------------------------------ message array index
42 N SEG ; ------------------------------- segment data
43 N NFLD ; ------------------------------ field number in the segment
44 N FLD ; ------------------------------- field data
45 ;
46 K @XMSG ; refresh target array
47 ; process MSH segment
48 Q:$D(@XTREE)<10 -1 ; parse tree sent?
49 S NSEG=$O(@XTREE@("")),NMSEG=1
50 Q:$G(@XTREE@(NSEG,0))'="MSH" -2 ; an HL7 message?
51 Q:$D(@XTREE@(NSEG,9,1,1,1))#10=0 -3 ; message type provided?
52 ; get delimiters or define defaults
53 S UFS=$G(@XTREE@(NSEG,1,1,1,1)) I $L(UFS)-1 S UFS="|"
54 S ENC=$G(@XTREE@(NSEG,2,1,1,1)) I $L(ENC)-4 S ENC="^~\&"
55 S UCS=$E(ENC),URS=$E(ENC,2),UEC=$E(ENC,3),USS=$E(ENC,4)
56 I $D(@XTREE@(NSEG,3,1,1,1))#10=0 S @XTREE@(1,3,1,1,1)="VistA Imaging"
57 D NOW^%DTC S @XTREE@(NSEG,7,1,1,1)=%*1000000+17000000000000
58 I $D(@XTREE@(NSEG,10,1,1,1))#10=0 D
59 . S X=""
60 . F I=1:1:16 S X=X_$E("0123456789ABCDEF",$R(16)+1)
61 . S @XTREE@(NSEG,10,1,1,1)=X
62 . Q
63 I $D(@XTREE@(NSEG,11,1,1,1))#10=0 S @XTREE@(NSEG,11,1,1,1)="D"
64 I $D(@XTREE@(NSEG,12,1,1,1))#10=0 S @XTREE@(NSEG,12,1,1,1)="2.3.1"
65 S SEG="MSH"_UFS_ENC
66 S NFLD=2
67 F S NFLD=$O(@XTREE@(NSEG,NFLD)) Q:NFLD="" D PROCFLD(XTREE,NSEG,NFLD,.SEG)
68 S @XMSG@(NMSEG)=SEG
69 F S NSEG=$O(@XTREE@(NSEG)) Q:'NSEG D
70 . K SEG
71 . S NMSEG=NMSEG+1
72 . S NFLD=0
73 . F S NFLD=$O(@XTREE@(NSEG,NFLD)) Q:NFLD="" D PROCFLD(XTREE,NSEG,NFLD,.SEG)
74 . S @XMSG@(NMSEG)=$G(@XTREE@(NSEG,0))_$S($G(SEG)]"":UFS_SEG,1:"")
75 . Q
76 Q 0
77 ;
78PROCFLD(XTREE,XNSEG,XNFLD,XSEG) ; process a field
79 ;
80 ; input: XTREE name of MUMPS array for parse tree ($NA format)
81 ; XNSEG segment number for parse tree
82 ; XNFLD field number for parse tree
83 ; .XSEG segment before addition of field
84 ;
85 ; output: .XSEG segment after addition of field
86 ;
87 N NREP ; ---- repetition (occurrence) number
88 N REP ; ----- repetition data
89 N NCMP ; ---- component number
90 N CMP ; ----- component data
91 N NSCM ; ---- subcomponent number
92 N SCM ; ----- subcomponent data
93 N FLD ; ----- field data
94 ;
95 S NREP=""
96 F S NREP=$O(@XTREE@(XNSEG,XNFLD,NREP)) Q:NREP="" D
97 . K REP
98 . S NCMP=""
99 . F S NCMP=$O(@XTREE@(XNSEG,XNFLD,NREP,NCMP)) Q:NCMP="" D
100 . . K CMP
101 . . S NSCM=""
102 . . F S NSCM=$O(@XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)) Q:NSCM="" D
103 . . . S SCM=@XTREE@(XNSEG,XNFLD,NREP,NCMP,NSCM)
104 . . . S $P(CMP,USS,NSCM)=$$ESC(.SCM)
105 . . . Q
106 . . S $P(REP,UCS,NCMP)=CMP
107 . . Q
108 . S $P(FLD,URS,NREP)=REP
109 . Q
110 S $P(XSEG,UFS,NFLD)=$G(FLD)
111 Q
112 ;
113ESC(XDTA) ;apply escape sequence to data
114 ; Insert an intermediate token, then expand the intermediate token to
115 ; the real escape sequence. (We have to do 2 steps because the escape
116 ; sequence uses the escape character.)
117 F Q:XDTA'[UFS S XDTA=$P(XDTA,UFS)_$C(1)_$P(XDTA,UFS,2,999)
118 F Q:XDTA'[UCS S XDTA=$P(XDTA,UCS)_$C(2)_$P(XDTA,UCS,2,999)
119 F Q:XDTA'[URS S XDTA=$P(XDTA,URS)_$C(3)_$P(XDTA,URS,2,999)
120 F Q:XDTA'[UEC S XDTA=$P(XDTA,UEC)_$C(4)_$P(XDTA,UEC,2,999)
121 F Q:XDTA'[USS S XDTA=$P(XDTA,USS)_$C(5)_$P(XDTA,USS,2,999)
122 F Q:XDTA'[$C(1) S XDTA=$P(XDTA,$C(1))_UEC_"F"_UEC_$P(XDTA,$C(1),2,999)
123 F Q:XDTA'[$C(2) S XDTA=$P(XDTA,$C(2))_UEC_"S"_UEC_$P(XDTA,$C(2),2,999)
124 F Q:XDTA'[$C(3) S XDTA=$P(XDTA,$C(3))_UEC_"R"_UEC_$P(XDTA,$C(3),2,999)
125 F Q:XDTA'[$C(4) S XDTA=$P(XDTA,$C(4))_UEC_"E"_UEC_$P(XDTA,$C(4),2,999)
126 F Q:XDTA'[$C(5) S XDTA=$P(XDTA,$C(5))_UEC_"T"_UEC_$P(XDTA,$C(5),2,999)
127 Q XDTA
Note: See TracBrowser for help on using the repository browser.