Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFHLZMH

VAFHLZMH.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine creates HL7 VA-specific Military History ("ZMH") segments
  1. Q
  1. ;
  1. EN(DFN,VAFHMIEN,VAFSTR) ; RAI/MDS Reserved entry point!!
  1. ; !!!!!!!!!! don't enter here !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  1. ;DFN - Patient Internal Entry Number
  1. ;VAFHMIEN - Patient Movement Internal Entry Number
  1. ;VAFSTR - Sequence numbers to be included
  1. ;
  1. N VAFHLREC,VAFHA,VAFHSUB,VAFHADD,VAFHLOC S VAFHSUB="" ;Initialize variables
  1. S $P(VAFHLREC,HL("FS"))="ZMH" ;Set segment ID to ZMH
  1. S $P(VAFHLREC,HL("FS"),2)=1 ;Set Set ID to 1
  1. I VAFSTR[",4," D
  1. .N EDATE,SDATE
  1. .I '$D(^DPT(DFN,.3216)) D
  1. ..S EDATE=$$HLDATE^HLFNC($$GET1^DIQ(2,DFN,".326","I"))
  1. ..S SDATE=$$HLDATE^HLFNC($$GET1^DIQ(2,DFN,".327","I"))
  1. .E D MSDSD
  1. .S $P(VAFHLREC,HL("FS"),5)=EDATE_$E(HL("ECH"))_SDATE
  1. Q VAFHLREC ;Quit and return formatted segment
  1. ;
  1. MSDSD ;Returns last service separation date from ESR sourced data
  1. N DA,DONE,EDATA
  1. S EDATE="",SDATE="",DONE=0
  1. F S EDATE=$O(^DPT(DFN,.3216,"B",""),-1) Q:'EDATE D Q:DONE
  1. .S DA=$O(^DPT(DFN,.3216,"B",EDATE,0)) Q:'DA
  1. .S EDATA=$G(^DPT(DFN,.3216,DA,0)) Q:EDATA=""
  1. .S DONE=1
  1. ;
  1. Q:'DONE
  1. S EDATE=$$HLDATE^HLFNC(EDATE)
  1. S SDATE=$$HLDATE^HLFNC($P(EDATA,U,2))
  1. Q
  1. ;
  1. ENTER(DFN,VAFARRAY,VAFTYPE,VAFSTR,VAFHLS,VAFHLC,VAFHLQ) ;
  1. ; DFN is the only required parameter. Defaults are used if no
  1. ; values are passed for the other parameters.
  1. ; Output:
  1. ; VAFARRAY = array name to hold the "ZMH" segments.
  1. ; Default is ^TMP("VAFHLZMH",$J)
  1. ; Input:
  1. ; DFN = internal entry number (IEN) of Patient (#2) file
  1. ; VAFTYPE = Military History type desired (separated by commas) where
  1. ; 1=Last Service branch (SL)
  1. ; 2=Next to last Service branch (SNL)
  1. ; 3=Next to next to last Service branch (SNNL)
  1. ; 4=Prisoner of War Status indicated? (POW)
  1. ; 5=Combat Service indicated? (COMB)
  1. ; 6=Vietnam Service indicated? (VIET)
  1. ; 7=Lebanon Service indicated? (LEBA)
  1. ; 8=Grenada Service indicated? (GREN)
  1. ; 9=Panama Service indicated? (PANA)
  1. ; 10=Persian Gulf Service indicated? (GULF)
  1. ; 11=Somalia Service indicated? (SOMA)
  1. ; 12=Yugoslavia Service indicated? (YUGO)
  1. ; 13=Purple Heart Receipient? (PH)
  1. ; 14=Operation Enduring/Iraqi Freedom (OEIF)
  1. ; A range of numbers separated by colons can be sent
  1. ; (e.g. 1:4,8,10:12)
  1. ; Default is all(1,2,3...)
  1. ;
  1. ; OR
  1. ;
  1. ; If value '*' is passed into the routine then the default
  1. ; is to return all military history and all military service
  1. ; episodes for the vet. Rather than using SL, SNL AND SNNL
  1. ; the ZMH type will be 'MSD'.
  1. ;
  1. ;
  1. ; VAFSTR = Fields (sequence numbers) desired (separated by comma) where
  1. ; 3=qualifier #1 (Service branch if VAFTYPE is 1,2 or 3
  1. ; or Yes/No response if VAFTYPE is 4 thru 13)
  1. ; qualifier #2 (Service number if VAFTYPE is 1,2 or 3
  1. ; or Location if VAFTYPE is 4 or 5)
  1. ; or
  1. ; qualifier #3 (Service discharge type if VAFTYPE is 1,2
  1. ; or 3)
  1. ; 4=From/To Date range for each VAFTYPE
  1. ; 5=Service Component
  1. ; Default is 3,4,5
  1. ; VAFHLS = HL7 field separator (1 character)
  1. ; Default is ^ (carrot)
  1. ; VAFHLC = HL7 encoding characters (4 characters must be supplied)
  1. ; Default is ~|\& (tilde bar backslash ampersand)
  1. ; VAFHLQ = HL7 null designation
  1. ; Default is "" (quote quote)
  1. ;
  1. ; Check input and apply default values as needed
  1. S VAFARRAY=$G(VAFARRAY) I VAFARRAY="" S VAFARRAY=$NA(^TMP("VAFHLZMH",$J))
  1. K @VAFARRAY
  1. S VAFTYPE=$G(VAFTYPE)
  1. I VAFTYPE="" S VAFTYPE="1,2,3,4,5,6,7,8,9,10,11,12,13,14"
  1. S VAFSTR=$G(VAFSTR) I VAFSTR="" S VAFSTR="3,4,5"
  1. S VAFHLS=$G(VAFHLS) I VAFHLS="" S VAFHLS="^"
  1. S:($L(VAFHLS)'=1) VAFHLS="^"
  1. S VAFHLC=$G(VAFHLC) I VAFHLC="" S VAFHLC="~|\&"
  1. S:($L(VAFHLC)'=4) VAFHLC="~|\&"
  1. S:('$D(VAFHLQ)) VAFHLQ=$C(34,34)
  1. I '$G(DFN) D NOGO Q
  1. I '$D(^DPT(DFN,0)) D NOGO Q
  1. S VAFSTR=$TR(VAFSTR,":",",")
  1. I VAFSTR'=3,VAFSTR'=4,VAFSTR'=5,VAFSTR'="3,4",VAFSTR'="3,5",VAFSTR'="4,5",VAFSTR'="3,4,5" D NOGO Q
  1. S VAFSTR=","_VAFSTR_","
  1. I VAFTYPE="*" S VAFTYPE="*,4,5,6,7,8,9,10,11,12,13,14"
  1. E I '$$EDIT(VAFTYPE) D NOGO Q
  1. I VAFTYPE[":" D UNCRUNCH
  1. ; it's a Go
  1. N VAFY,VAFX,VAFZ,VAFINDX,VAFTAG
  1. S VAFINDX=0
  1. ; set all the Patient file nodes that may be needed
  1. N VAF32N,VAF321N,VAF322N,VAF52N,VAF53N,VAF3291N
  1. S VAF321N=$G(^DPT(DFN,.321)) ; used for Vietnam
  1. S VAF322N=$G(^DPT(DFN,.322)) ; used for minor skirmishes
  1. S VAF52N=$G(^DPT(DFN,.52)) ; used for POW and Combat
  1. S VAF53N=$G(^DPT(DFN,.53)) ;used for Purple Heart
  1. I '$D(^DPT(DFN,.3216)) D
  1. .S VAF32N=$G(^DPT(DFN,.32)) ; used for Service branches
  1. .S VAF3291N=$G(^DPT(DFN,.3291)) ;used for service component
  1. I $D(^DPT(DFN,.3216)),VAFTYPE'["*" D MSDS
  1. ;used for Operation Enduring/Iraqi Freedom
  1. N VAFOPS,VAFREC,VAFSUB
  1. S (VAFREC,VAFSUB)=0
  1. ;set operations into local array since there may be mult OEIF episodes
  1. F S VAFREC=$O(^DPT(DFN,.3215,VAFREC)) Q:'$G(VAFREC) D
  1. . S VAFSUB=VAFSUB+1
  1. . S VAFOPS(VAFSUB)=$G(^DPT(DFN,.3215,VAFREC,0))
  1. ;
  1. D ENTER^VAFHLZM1
  1. ;
  1. Q
  1. ;
  1. MSDS ;Returns latest service episodes from ESR sourced data
  1. ;
  1. ;*** the number of episodes is unlimited ****
  1. ;
  1. N BRANCH,COUNT,COMP,DA,DONE,DTYP,EDATA,EDATE,SDATE,SERVNO,SUB
  1. S COUNT=0,EDATE="",VAF32N="",VAF3291N=""
  1. ;Scan back for three most recent service episodes
  1. F S EDATE=$O(^DPT(DFN,.3216,"B",EDATE),-1) Q:'EDATE D Q:COUNT'<3
  1. .S DA=$O(^DPT(DFN,.3216,"B",EDATE,0)) Q:'DA
  1. .S EDATA=$G(^DPT(DFN,.3216,DA,0)) Q:EDATA=""
  1. .;DJS, skip an MSE that has a Future Discharge Date; DG*5.3*935
  1. .Q:$P(EDATA,U,8)'=""
  1. .S COUNT=COUNT+1,SDATE=$P(EDATA,U,2)
  1. .S BRANCH=$P(EDATA,U,3),COMP=$P(EDATA,U,4)
  1. .S SERVNO=$P(EDATA,U,5),DTYP=$P(EDATA,U,6)
  1. .;SL = 4, SNL = 9 or SNNL = 14
  1. .S SUB=(COUNT*5)-1
  1. .S $P(VAF32N,U,SUB)=DTYP
  1. .S $P(VAF32N,U,SUB+1)=BRANCH
  1. .S $P(VAF32N,U,SUB+2)=EDATE
  1. .S $P(VAF32N,U,SUB+3)=SDATE
  1. .S $P(VAF32N,U,SUB+4)=SERVNO
  1. .S $P(VAF3291N,U,COUNT)=COMP
  1. Q
  1. ;
  1. EDIT(X) ; function validates VAFTYP (returns 1 if valid)
  1. N P,Q,R,CNT,Z,Z1,Z2,ERR S ERR=0
  1. S X=$G(X)
  1. I X>0,X<15,X?.N Q 1 ; only 1 number and between 1-14
  1. I X'[":",X'["," Q 0 ; comma not used as separator
  1. I X'?.NP Q 0 ; contains letters or control characters
  1. ; contains punctuation other than comma/colon
  1. S P="!#$%&'()*+-./;<=>?@[\]^_`{|]~"
  1. F CNT=1:1 S Z=$E(X,CNT) Q:Z="" I P[Z S ERR=1 Q
  1. I ERR=1 Q 0
  1. S Q="",R=""""
  1. I Q[X!R[X Q 0
  1. ; checks that numbers are >0<15
  1. F CNT=1:1 S Z=$P(X,",",CNT) Q:Z="" D
  1. .I Z'[":",Z>0,Z<15 Q
  1. .S Z1=$P(Z,":",1),Z2=$P(Z,":",2)
  1. .I Z1>0,Z1<15,Z2>0,Z2<15 Q
  1. .S ERR=1
  1. I ERR=1 Q 0
  1. Q 1
  1. ;
  1. 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,"
  1. N X,Y,Z,A,B S Y=""
  1. F X=1:1 S Z=$P(VAFTYPE,",",X) Q:Z="" D
  1. .I Z'[":" S Y=Y_Z_"," Q
  1. .S A=$P(Z,":",1),B=$P(Z,":",2)
  1. .S Y=Y_A_","
  1. .F S A=A+1 Q:A>B S Y=Y_A_","
  1. S VAFTYPE=Y
  1. Q
  1. NOGO ;
  1. S @VAFARRAY@(1,0)="ZMH"_VAFHLS_1
  1. Q