- VAFHLZMH ;BAY/JAT,PJH,DJS - Create HL7 Military History seg. (ZMH) ;2 Nov 2017 7:16pm
- ;;5.3;Registration;**190,314,673,797,935**;Aug 13, 1993;Build 53
- ;
- ; 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," D
- .N EDATE,SDATE
- .I '$D(^DPT(DFN,.3216)) D
- ..S EDATE=$$HLDATE^HLFNC($$GET1^DIQ(2,DFN,".326","I"))
- ..S SDATE=$$HLDATE^HLFNC($$GET1^DIQ(2,DFN,".327","I"))
- .E D MSDSD
- .S $P(VAFHLREC,HL("FS"),5)=EDATE_$E(HL("ECH"))_SDATE
- Q VAFHLREC ;Quit and return formatted segment
- ;
- MSDSD ;Returns last service separation date from ESR sourced data
- N DA,DONE,EDATA
- S EDATE="",SDATE="",DONE=0
- F S EDATE=$O(^DPT(DFN,.3216,"B",""),-1) Q:'EDATE D Q:DONE
- .S DA=$O(^DPT(DFN,.3216,"B",EDATE,0)) Q:'DA
- .S EDATA=$G(^DPT(DFN,.3216,DA,0)) Q:EDATA=""
- .S DONE=1
- ;
- Q:'DONE
- S EDATE=$$HLDATE^HLFNC(EDATE)
- S SDATE=$$HLDATE^HLFNC($P(EDATA,U,2))
- Q
- ;
- 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...)
- ;
- ; OR
- ;
- ; If value '*' is passed into the routine then the default
- ; is to return all military history and all military service
- ; episodes for the vet. Rather than using SL, SNL AND SNNL
- ; the ZMH type will be 'MSD'.
- ;
- ;
- ; 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 VAFTYPE="*" S VAFTYPE="*,4,5,6,7,8,9,10,11,12,13,14"
- E 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 VAF321N=$G(^DPT(DFN,.321)) ; used for Vietnam
- S VAF322N=$G(^DPT(DFN,.322)) ; used for minor skirmishes
- S VAF52N=$G(^DPT(DFN,.52)) ; used for POW and Combat
- S VAF53N=$G(^DPT(DFN,.53)) ;used for Purple Heart
- I '$D(^DPT(DFN,.3216)) D
- .S VAF32N=$G(^DPT(DFN,.32)) ; used for Service branches
- .S VAF3291N=$G(^DPT(DFN,.3291)) ;used for service component
- I $D(^DPT(DFN,.3216)),VAFTYPE'["*" D MSDS
- ;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
- ;
- MSDS ;Returns latest service episodes from ESR sourced data
- ;
- ;*** the number of episodes is unlimited ****
- ;
- N BRANCH,COUNT,COMP,DA,DONE,DTYP,EDATA,EDATE,SDATE,SERVNO,SUB
- S COUNT=0,EDATE="",VAF32N="",VAF3291N=""
- ;Scan back for three most recent service episodes
- F S EDATE=$O(^DPT(DFN,.3216,"B",EDATE),-1) Q:'EDATE D Q:COUNT'<3
- .S DA=$O(^DPT(DFN,.3216,"B",EDATE,0)) Q:'DA
- .S EDATA=$G(^DPT(DFN,.3216,DA,0)) Q:EDATA=""
- .;DJS, skip an MSE that has a Future Discharge Date; DG*5.3*935
- .Q:$P(EDATA,U,8)'=""
- .S COUNT=COUNT+1,SDATE=$P(EDATA,U,2)
- .S BRANCH=$P(EDATA,U,3),COMP=$P(EDATA,U,4)
- .S SERVNO=$P(EDATA,U,5),DTYP=$P(EDATA,U,6)
- .;SL = 4, SNL = 9 or SNNL = 14
- .S SUB=(COUNT*5)-1
- .S $P(VAF32N,U,SUB)=DTYP
- .S $P(VAF32N,U,SUB+1)=BRANCH
- .S $P(VAF32N,U,SUB+2)=EDATE
- .S $P(VAF32N,U,SUB+3)=SDATE
- .S $P(VAF32N,U,SUB+4)=SERVNO
- .S $P(VAF3291N,U,COUNT)=COMP
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZMH 7461 printed Feb 19, 2025@00:29:36 Page 2
- VAFHLZMH ;BAY/JAT,PJH,DJS - Create HL7 Military History seg. (ZMH) ;2 Nov 2017 7:16pm
- +1 ;;5.3;Registration;**190,314,673,797,935**;Aug 13, 1993;Build 53
- +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 IF VAFSTR[",4,"
- Begin DoDot:1
- +10 NEW EDATE,SDATE
- +11 IF '$DATA(^DPT(DFN,.3216))
- Begin DoDot:2
- +12 SET EDATE=$$HLDATE^HLFNC($$GET1^DIQ(2,DFN,".326","I"))
- +13 SET SDATE=$$HLDATE^HLFNC($$GET1^DIQ(2,DFN,".327","I"))
- End DoDot:2
- +14 IF '$TEST
- DO MSDSD
- +15 SET $PIECE(VAFHLREC,HL("FS"),5)=EDATE_$EXTRACT(HL("ECH"))_SDATE
- End DoDot:1
- +16 ;Quit and return formatted segment
- QUIT VAFHLREC
- +17 ;
- MSDSD ;Returns last service separation date from ESR sourced data
- +1 NEW DA,DONE,EDATA
- +2 SET EDATE=""
- SET SDATE=""
- SET DONE=0
- +3 FOR
- SET EDATE=$ORDER(^DPT(DFN,.3216,"B",""),-1)
- if 'EDATE
- QUIT
- Begin DoDot:1
- +4 SET DA=$ORDER(^DPT(DFN,.3216,"B",EDATE,0))
- if 'DA
- QUIT
- +5 SET EDATA=$GET(^DPT(DFN,.3216,DA,0))
- if EDATA=""
- QUIT
- +6 SET DONE=1
- End DoDot:1
- if DONE
- QUIT
- +7 ;
- +8 if 'DONE
- QUIT
- +9 SET EDATE=$$HLDATE^HLFNC(EDATE)
- +10 SET SDATE=$$HLDATE^HLFNC($PIECE(EDATA,U,2))
- +11 QUIT
- +12 ;
- 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 ;
- +27 ; OR
- +28 ;
- +29 ; If value '*' is passed into the routine then the default
- +30 ; is to return all military history and all military service
- +31 ; episodes for the vet. Rather than using SL, SNL AND SNNL
- +32 ; the ZMH type will be 'MSD'.
- +33 ;
- +34 ;
- +35 ; VAFSTR = Fields (sequence numbers) desired (separated by comma) where
- +36 ; 3=qualifier #1 (Service branch if VAFTYPE is 1,2 or 3
- +37 ; or Yes/No response if VAFTYPE is 4 thru 13)
- +38 ; qualifier #2 (Service number if VAFTYPE is 1,2 or 3
- +39 ; or Location if VAFTYPE is 4 or 5)
- +40 ; or
- +41 ; qualifier #3 (Service discharge type if VAFTYPE is 1,2
- +42 ; or 3)
- +43 ; 4=From/To Date range for each VAFTYPE
- +44 ; 5=Service Component
- +45 ; Default is 3,4,5
- +46 ; VAFHLS = HL7 field separator (1 character)
- +47 ; Default is ^ (carrot)
- +48 ; VAFHLC = HL7 encoding characters (4 characters must be supplied)
- +49 ; Default is ~|\& (tilde bar backslash ampersand)
- +50 ; VAFHLQ = HL7 null designation
- +51 ; Default is "" (quote quote)
- +52 ;
- +53 ; Check input and apply default values as needed
- +54 SET VAFARRAY=$GET(VAFARRAY)
- IF VAFARRAY=""
- SET VAFARRAY=$NAME(^TMP("VAFHLZMH",$JOB))
- +55 KILL @VAFARRAY
- +56 SET VAFTYPE=$GET(VAFTYPE)
- +57 IF VAFTYPE=""
- SET VAFTYPE="1,2,3,4,5,6,7,8,9,10,11,12,13,14"
- +58 SET VAFSTR=$GET(VAFSTR)
- IF VAFSTR=""
- SET VAFSTR="3,4,5"
- +59 SET VAFHLS=$GET(VAFHLS)
- IF VAFHLS=""
- SET VAFHLS="^"
- +60 if ($LENGTH(VAFHLS)'=1)
- SET VAFHLS="^"
- +61 SET VAFHLC=$GET(VAFHLC)
- IF VAFHLC=""
- SET VAFHLC="~|\&"
- +62 if ($LENGTH(VAFHLC)'=4)
- SET VAFHLC="~|\&"
- +63 if ('$DATA(VAFHLQ))
- SET VAFHLQ=$CHAR(34,34)
- +64 IF '$GET(DFN)
- DO NOGO
- QUIT
- +65 IF '$DATA(^DPT(DFN,0))
- DO NOGO
- QUIT
- +66 SET VAFSTR=$TRANSLATE(VAFSTR,":",",")
- +67 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
- +68 SET VAFSTR=","_VAFSTR_","
- +69 IF VAFTYPE="*"
- SET VAFTYPE="*,4,5,6,7,8,9,10,11,12,13,14"
- +70 IF '$TEST
- IF '$$EDIT(VAFTYPE)
- DO NOGO
- QUIT
- +71 IF VAFTYPE[":"
- DO UNCRUNCH
- +72 ; it's a Go
- +73 NEW VAFY,VAFX,VAFZ,VAFINDX,VAFTAG
- +74 SET VAFINDX=0
- +75 ; set all the Patient file nodes that may be needed
- +76 NEW VAF32N,VAF321N,VAF322N,VAF52N,VAF53N,VAF3291N
- +77 ; used for Vietnam
- SET VAF321N=$GET(^DPT(DFN,.321))
- +78 ; used for minor skirmishes
- SET VAF322N=$GET(^DPT(DFN,.322))
- +79 ; used for POW and Combat
- SET VAF52N=$GET(^DPT(DFN,.52))
- +80 ;used for Purple Heart
- SET VAF53N=$GET(^DPT(DFN,.53))
- +81 IF '$DATA(^DPT(DFN,.3216))
- Begin DoDot:1
- +82 ; used for Service branches
- SET VAF32N=$GET(^DPT(DFN,.32))
- +83 ;used for service component
- SET VAF3291N=$GET(^DPT(DFN,.3291))
- End DoDot:1
- +84 IF $DATA(^DPT(DFN,.3216))
- IF VAFTYPE'["*"
- DO MSDS
- +85 ;used for Operation Enduring/Iraqi Freedom
- +86 NEW VAFOPS,VAFREC,VAFSUB
- +87 SET (VAFREC,VAFSUB)=0
- +88 ;set operations into local array since there may be mult OEIF episodes
- +89 FOR
- SET VAFREC=$ORDER(^DPT(DFN,.3215,VAFREC))
- if '$GET(VAFREC)
- QUIT
- Begin DoDot:1
- +90 SET VAFSUB=VAFSUB+1
- +91 SET VAFOPS(VAFSUB)=$GET(^DPT(DFN,.3215,VAFREC,0))
- End DoDot:1
- +92 ;
- +93 DO ENTER^VAFHLZM1
- +94 ;
- +95 QUIT
- +96 ;
- MSDS ;Returns latest service episodes from ESR sourced data
- +1 ;
- +2 ;*** the number of episodes is unlimited ****
- +3 ;
- +4 NEW BRANCH,COUNT,COMP,DA,DONE,DTYP,EDATA,EDATE,SDATE,SERVNO,SUB
- +5 SET COUNT=0
- SET EDATE=""
- SET VAF32N=""
- SET VAF3291N=""
- +6 ;Scan back for three most recent service episodes
- +7 FOR
- SET EDATE=$ORDER(^DPT(DFN,.3216,"B",EDATE),-1)
- if 'EDATE
- QUIT
- Begin DoDot:1
- +8 SET DA=$ORDER(^DPT(DFN,.3216,"B",EDATE,0))
- if 'DA
- QUIT
- +9 SET EDATA=$GET(^DPT(DFN,.3216,DA,0))
- if EDATA=""
- QUIT
- +10 ;DJS, skip an MSE that has a Future Discharge Date; DG*5.3*935
- +11 if $PIECE(EDATA,U,8)'=""
- QUIT
- +12 SET COUNT=COUNT+1
- SET SDATE=$PIECE(EDATA,U,2)
- +13 SET BRANCH=$PIECE(EDATA,U,3)
- SET COMP=$PIECE(EDATA,U,4)
- +14 SET SERVNO=$PIECE(EDATA,U,5)
- SET DTYP=$PIECE(EDATA,U,6)
- +15 ;SL = 4, SNL = 9 or SNNL = 14
- +16 SET SUB=(COUNT*5)-1
- +17 SET $PIECE(VAF32N,U,SUB)=DTYP
- +18 SET $PIECE(VAF32N,U,SUB+1)=BRANCH
- +19 SET $PIECE(VAF32N,U,SUB+2)=EDATE
- +20 SET $PIECE(VAF32N,U,SUB+3)=SDATE
- +21 SET $PIECE(VAF32N,U,SUB+4)=SERVNO
- +22 SET $PIECE(VAF3291N,U,COUNT)=COMP
- End DoDot:1
- if COUNT'<3
- QUIT
- +23 QUIT
- +24 ;
- 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