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