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

VAFHLPID.m

Go to the documentation of this file.
  1. VAFHLPID ;ALB/MLI/ESD - Create generic PID segment ; 21 Nov 2002 3:13 PM
  1. ;;5.3;Registration;**68,94,415,508,749**;Aug 13, 1993;Build 10
  1. ;
  1. ; This routine returns the HL7 defined PID segment with its
  1. ; mappings to DHCP PATIENT file fields.
  1. ;
  1. EN(DFN,VAFSTR,VAFNUM,PTID) ; returns PID segment
  1. ; Input - DFN as internal entry number of the PATIENT file
  1. ; VAFSTR as string of fields requested separated by commas
  1. ; VAFNUM as sequential number for SET ID (default=1)
  1. ; PTID is flag denoting which Patient ID (seq 3) to use
  1. ; 0 - Use DFN formatted as data type CK (default)
  1. ; 1 - Use ICN
  1. ; 2 - Use DFN formatted as data type CX
  1. ; 3 - Use SSN (with dashes)
  1. ;
  1. ; ****Also assumes all HL7 variables returned from****
  1. ; INIT^HLTRANS are defined
  1. ;
  1. ; Output - String containing the desired components of the PID segment
  1. ; VAFPID(n) - if the string is longer than 245, the remaining
  1. ; characters will be returned in VAFPID(n) where
  1. ; n is a sequential number beginning with 1
  1. ;
  1. ; WARNING: This routine makes external calls to VADPT. Non-namespaced
  1. ; variables may be altered.
  1. ;
  1. N I,VAFY,VA,VADM,X,X1,Y,OUTPUT,DGNAME,DGMMN,VAPA ; calls VADPT...have to NEW
  1. S VAFSTR=$G(VAFSTR) ; if not defined, just return required fields
  1. S DFN=$G(DFN)
  1. I DFN']"" G QUIT
  1. ;Get demographics and permanent address
  1. S VAPA("P")="" D 4^VADPT
  1. S VAFSTR=","_VAFSTR_","
  1. K VAFY
  1. ;Set ID (#1)
  1. I VAFSTR[",1," S VAFY(1)=$S($G(VAFNUM):VAFNUM,1:1)
  1. ;External ID (#2)
  1. I VAFSTR[",2," S X=$G(VA("PID")),VAFY(2)=$S(X]"":$$M10^HLFNC(X),1:HLQ)
  1. ;Patient ID (#3 - req)
  1. S PTID=+$G(PTID)
  1. I 'PTID S VAFY(3)=$$M10^HLFNC(DFN)
  1. I PTID D
  1. .S X=$S(PTID=1:"NI",PTID=2:"PI",PTID=3:"SS")
  1. .S VAFY(3)=$$SEQ3^VAFHLPI1(DFN,X,HLECH,HLQ)
  1. ;Alternate ID (#4)
  1. I VAFSTR[",4," S X=$G(VA("BID")),VAFY(4)=$S(X]"":X,1:HLQ)
  1. ;Name (#5 - req)
  1. S DGNAME("FILE")=2,DGNAME("IENS")=DFN,DGNAME("FIELD")=.01
  1. S X=$$HLNAME^XLFNAME(.DGNAME,"",$E(HLECH)),VAFY(5)=$S(X]"":X,1:HLQ)
  1. ;Mother's maiden name (#6)
  1. I VAFSTR[",6," D
  1. .S DGMMN("FILE")=2,DGMMN("IENS")=DFN,DGMMN("FIELD")=.2403
  1. .S X=$$HLNAME^XLFNAME(.DGMMN,"",$E(HLECH)),VAFY(6)=$S(X]"":X,1:HLQ)
  1. ;Date of birth (#7)
  1. I VAFSTR[",7," S VAFY(7)=$$HLDATE^HLFNC(+VADM(3))
  1. ;Sex (#8)
  1. I VAFSTR[",8," S X=$P(VADM(5),"^",1),VAFY(8)=$S("^M^F^"[("^"_X_"^"):X,1:"U")
  1. ;Race (#10)
  1. I VAFSTR[10 D
  1. .N HOW
  1. .S Y=$F(VAFSTR,"10")
  1. .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1)
  1. .D SEQ10^VAFHLPI1(HOW,HLQ)
  1. ;Address (#11)
  1. I VAFSTR[11 D
  1. .N HOW
  1. .S Y=$F(VAFSTR,"11")
  1. .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1)
  1. .D SEQ11^VAFHLPI2(HOW,HLQ)
  1. ;County (#12)
  1. I VAFSTR[12 S X1=$P($G(^DIC(5,+$G(VAPA(5)),1,+$G(VAPA(7)),0)),"^",3),VAFY(12)=$S(X1]"":X1,1:HLQ)
  1. S X=$G(^DPT(DFN,.13))
  1. ;Home phone (#13)
  1. I VAFSTR[13 S X1=$$HLPHONE^HLFNC($P(X,"^",1)),VAFY(13)=$S(X1]"":X1,1:HLQ)
  1. ;Business phone (#14)
  1. I VAFSTR[14 S X1=$$HLPHONE^HLFNC($P(X,"^",2)),VAFY(14)=$S(X1]"":X1,1:HLQ)
  1. ;Marital status (#16)
  1. I VAFSTR[16 S X=$P($G(^DIC(11,+VADM(10),0)),"^",3),VAFY(16)=$S(X="N":"S",X="U":"",X="":HLQ,1:X)
  1. ;Religious preference (#17) (if blank send 29 (UNKNOWN))
  1. I VAFSTR[17 S X=$P($G(^DIC(13,+VADM(9),0)),"^",4),VAFY(17)=$S(X]"":X,1:29)
  1. ;SSN (#19)
  1. I VAFSTR[19 S X=$P(VADM(2),"^",1),VAFY(19)=$S(X]"":X,1:HLQ)
  1. ;Ethnicity (#22)
  1. I VAFSTR[22 D
  1. .N HOW
  1. .S Y=$F(VAFSTR,"22")
  1. .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1)
  1. .D SEQ22^VAFHLPI1(HOW,HLQ)
  1. ;
  1. QUIT D KVA^VADPT
  1. D MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID)
  1. Q OUTPUT