source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLZMH.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 5.4 KB
Line 
1VAFHLZMH ;BAY/JAT - Create HL7 Military History segment (ZMH) ; 11/20/00 2:14pm
2 ;;5.3;Registration;**190,314,673**;Aug 13, 1993
3 ;
4 ; This routine creates HL7 VA-specific Military History ("ZMH") segments
5 Q
6 ;
7EN(DFN,VAFHMIEN,VAFSTR) ; RAI/MDS Reserved entry point!!
8 ; !!!!!!!!!! don't enter here !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
9 ;DFN - Patient Internal Entry Number
10 ;VAFHMIEN - Patient Movement Internal Entry Number
11 ;VAFSTR - Sequence numbers to be included
12 ;
13 N VAFHLREC,VAFHA,VAFHSUB,VAFHADD,VAFHLOC S VAFHSUB="" ;Initialize variables
14 S $P(VAFHLREC,HL("FS"))="ZMH" ;Set segment ID to ZMH
15 S $P(VAFHLREC,HL("FS"),2)=1 ;Set Set ID to 1
16 I VAFSTR[",4," S $P(VAFHLREC,HL("FS"),5)=$$HLDATE^HLFNC($$GET1^DIQ(2,DFN,".326","I"))_$E(HL("ECH"))_$$HLDATE^HLFNC($$GET1^DIQ(2,DFN,".327","I")) ;Last Service Entry and Separation dates
17 Q VAFHLREC ;Quit and return formatted segment
18 ;
19ENTER(DFN,VAFARRAY,VAFTYPE,VAFSTR,VAFHLS,VAFHLC,VAFHLQ) ;
20 ; DFN is the only required parameter. Defaults are used if no
21 ; values are passed for the other parameters.
22 ; Output:
23 ; VAFARRAY = array name to hold the "ZMH" segments.
24 ; Default is ^TMP("VAFHLZMH",$J)
25 ; Input:
26 ; DFN = internal entry number (IEN) of Patient (#2) file
27 ; VAFTYPE = Military History type desired (separated by commas) where
28 ; 1=Last Service branch (SL)
29 ; 2=Next to last Service branch (SNL)
30 ; 3=Next to next to last Service branch (SNNL)
31 ; 4=Prisoner of War Status indicated? (POW)
32 ; 5=Combat Service indicated? (COMB)
33 ; 6=Vietnam Service indicated? (VIET)
34 ; 7=Lebanon Service indicated? (LEBA)
35 ; 8=Grenada Service indicated? (GREN)
36 ; 9=Panama Service indicated? (PANA)
37 ; 10=Persian Gulf Service indicated? (GULF)
38 ; 11=Somalia Service indicated? (SOMA)
39 ; 12=Yugoslavia Service indicated? (YUGO)
40 ; 13=Purple Heart Receipient? (PH)
41 ; 14=Operation Enduring/Iraqi Freedom (OEIF)
42 ; A range of numbers separated by colons can be sent
43 ; (e.g. 1:4,8,10:12)
44 ; Default is all(1,2,3...)
45 ; VAFSTR = Fields (sequence numbers) desired (separated by comma) where
46 ; 3=qualifier #1 (Service branch if VAFTYPE is 1,2 or 3
47 ; or Yes/No response if VAFTYPE is 4 thru 13)
48 ; qualifier #2 (Service number if VAFTYPE is 1,2 or 3
49 ; or Location if VAFTYPE is 4 or 5)
50 ; or
51 ; qualifier #3 (Service discharge type if VAFTYPE is 1,2
52 ; or 3)
53 ; 4=From/To Date range for each VAFTYPE
54 ; 5=Service Component
55 ; Default is 3,4,5
56 ; VAFHLS = HL7 field separator (1 character)
57 ; Default is ^ (carrot)
58 ; VAFHLC = HL7 encoding characters (4 characters must be supplied)
59 ; Default is ~|\& (tilde bar backslash ampersand)
60 ; VAFHLQ = HL7 null designation
61 ; Default is "" (quote quote)
62 ;
63 ; Check input and apply default values as needed
64 S VAFARRAY=$G(VAFARRAY) I VAFARRAY="" S VAFARRAY=$NA(^TMP("VAFHLZMH",$J))
65 K @VAFARRAY
66 S VAFTYPE=$G(VAFTYPE) I VAFTYPE="" S VAFTYPE="1,2,3,4,5,6,7,8,9,10,11,12,13,14"
67 S VAFSTR=$G(VAFSTR) I VAFSTR="" S VAFSTR="3,4,5"
68 S VAFHLS=$G(VAFHLS) I VAFHLS="" S VAFHLS="^"
69 S:($L(VAFHLS)'=1) VAFHLS="^"
70 S VAFHLC=$G(VAFHLC) I VAFHLC="" S VAFHLC="~|\&"
71 S:($L(VAFHLC)'=4) VAFHLC="~|\&"
72 S:('$D(VAFHLQ)) VAFHLQ=$C(34,34)
73 I '$G(DFN) D NOGO Q
74 I '$D(^DPT(DFN,0)) D NOGO Q
75 S VAFSTR=$TR(VAFSTR,":",",")
76 I VAFSTR'=3,VAFSTR'=4,VAFSTR'=5,VAFSTR'="3,4",VAFSTR'="3,5",VAFSTR'="4,5",VAFSTR'="3,4,5" D NOGO Q
77 S VAFSTR=","_VAFSTR_","
78 I '$$EDIT(VAFTYPE) D NOGO Q
79 I VAFTYPE[":" D UNCRUNCH
80 ; it's a Go
81 N VAFY,VAFX,VAFZ,VAFINDX,VAFTAG
82 S VAFINDX=0
83 ; set all the Patient file nodes that may be needed
84 N VAF32N,VAF321N,VAF322N,VAF52N,VAF53N,VAF3291N
85 S VAF32N=$G(^DPT(DFN,.32)) ; used for Service branches
86 S VAF321N=$G(^DPT(DFN,.321)) ; used for Vietnam
87 S VAF322N=$G(^DPT(DFN,.322)) ; used for minor skirmishes
88 S VAF3291N=$G(^DPT(DFN,.3291)) ;used for service component
89 S VAF52N=$G(^DPT(DFN,.52)) ; used for POW and Combat
90 S VAF53N=$G(^DPT(DFN,.53)) ;used for Purple Heart
91 ;used for Operation Enduring/Iraqi Freedom
92 N VAFOPS,VAFREC,VAFSUB
93 S (VAFREC,VAFSUB)=0
94 ;set operations into local array since there may be mult OEIF episodes
95 F S VAFREC=$O(^DPT(DFN,.3215,VAFREC)) Q:'$G(VAFREC) D
96 . S VAFSUB=VAFSUB+1
97 . S VAFOPS(VAFSUB)=$G(^DPT(DFN,.3215,VAFREC,0))
98 ;
99 D ENTER^VAFHLZM1
100 ;
101 Q
102 ;
103EDIT(X) ; function validates VAFTYP (returns 1 if valid)
104 N P,Q,R,CNT,Z,Z1,Z2,ERR S ERR=0
105 S X=$G(X)
106 I X>0,X<15,X?.N Q 1 ; only 1 number and between 1-14
107 I X'[":",X'["," Q 0 ; comma not used as separator
108 I X'?.NP Q 0 ; contains letters or control characters
109 ; contains punctuation other than comma/colon
110 S P="!#$%&'()*+-./;<=>?@[\]^_`{|]~"
111 F CNT=1:1 S Z=$E(X,CNT) Q:Z="" I P[Z S ERR=1 Q
112 I ERR=1 Q 0
113 S Q="",R=""""
114 I Q[X!R[X Q 0
115 ; checks that numbers are >0<15
116 F CNT=1:1 S Z=$P(X,",",CNT) Q:Z="" D
117 .I Z'[":",Z>0,Z<15 Q
118 .S Z1=$P(Z,":",1),Z2=$P(Z,":",2)
119 .I Z1>0,Z1<15,Z2>0,Z2<15 Q
120 .S ERR=1
121 I ERR=1 Q 0
122 Q 1
123 ;
124UNCRUNCH ; reformat VAFTYPE by translating any range of numbers,
125 ; for example replace "1:3,6,9:11" by "1,2,3,6,9,10,11,"
126 N X,Y,Z,A,B S Y=""
127 F X=1:1 S Z=$P(VAFTYPE,",",X) Q:Z="" D
128 .I Z'[":" S Y=Y_Z_"," Q
129 .S A=$P(Z,":",1),B=$P(Z,":",2)
130 .S Y=Y_A_","
131 .F S A=A+1 Q:A>B S Y=Y_A_","
132 S VAFTYPE=Y
133 Q
134NOGO ;
135 S @VAFARRAY@(1,0)="ZMH"_VAFHLS_1
136 Q
Note: See TracBrowser for help on using the repository browser.