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 - Create HL7 Military History segment (ZMH) ; 11/20/00 2:14pm
  1.  ;;5.3;Registration;**190,314,673,1015**;Aug 13, 1993;Build 21
  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," 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
  1.  Q VAFHLREC ;Quit and return formatted segment
  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.  ; 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) 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 '$$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 VAF32N=$G(^DPT(DFN,.32)) ; used for Service branches
  1.  S VAF321N=$G(^DPT(DFN,.321)) ; used for Vietnam
  1.  S VAF322N=$G(^DPT(DFN,.322)) ; used for minor skirmishes
  1.  S VAF3291N=$G(^DPT(DFN,.3291)) ;used for service component
  1.  S VAF52N=$G(^DPT(DFN,.52)) ; used for POW and Combat
  1.  S VAF53N=$G(^DPT(DFN,.53)) ;used for Purple Heart
  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. 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