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

VAFCPID.m

Go to the documentation of this file. 
  1. VAFCPID ;ALB/MLI,PKE-Create generic PID segment ; 21 Nov 2002  3:13 PM
  1.  ;;5.3;PIMS;**91,149,190,415,508,749,1015,1016**;JUN 30, 2012;Build 20
  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) ; 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.  ;
  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 - always included)
  1.  S X=$$GETICN^MPIF001(DFN) S:(+X=-1) X="" S VAFY(2)=$S(X]"":X,1:HLQ)
  1.  ;Patient ID (#3 - req)
  1.  S VAFY(3)=$$M10^HLFNC(DFN)
  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="M":"M",X="N":"S",X="S":"A",X]"":X,1:HLQ)
  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.  ;Birth place (#23)
  1.  I VAFSTR[23 D
  1.  .N DGBC,DGBS
  1.  .S DGBC=$$GET1^DIQ(2,DFN,.092,"I")
  1.  .S DGBS=$$GET1^DIQ(2,DFN,.093,"E")
  1.  .S VAFY(23)=DGBC_" "_DGBS
  1.  ;Date of death (#29) & Death indicator (#30) (always included if dead)
  1.  S X=+VADM(6) I X D
  1.  .S VAFY(29)=$$HLDATE^HLFNC(X)
  1.  .S VAFY(30)="Y"
  1.  ;
  1. QUIT D KVA^VADPT
  1.  D MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID)
  1.  Q OUTPUT
  1.  ;
  1. ADDR(VAFADDR,VAFCOUNT) ;Return HL7 address
  1.  ; Input  - VAFADDR as address in format:
  1.  ;            line1^line2^line3^city^state^zip+4
  1.  ;          VAFCOUNT as internal value of county (optional)
  1.  ; Output - HL7 v2.3 formatted Address_HLFS_County Code
  1.  ;
  1.  ;      ****Also assumes all HL7 variables returned from****
  1.  ;          INIT^HLTRANS are defined
  1.  ;
  1.  N X,Y,Z S X=$E(HLECH)
  1.  ;Street address (line 1)
  1.  S $P(Y,X,1)=$P(VAFADDR,"^",1)
  1.  ;Other designation (line 2)
  1.  S $P(Y,X,2)=$P(VAFADDR,"^",2)
  1.  ;City
  1.  S $P(Y,X,3)=$P(VAFADDR,"^",4)
  1.  ;State
  1.  S $P(Y,X,4)=$P($G(^DIC(5,+$P(VAFADDR,"^",5),0)),"^",2)
  1.  ;Zip
  1.  S $P(Y,X,5)=$P(VAFADDR,"^",6)
  1.  ;Other geographic designation (line 3)
  1.  S $P(Y,X,8)=$P(VAFADDR,"^",3)
  1.  ;County
  1.  S $P(Y,X,9)=$P($G(^DIC(5,+$P(VAFADDR,"^",5),1,+$G(VAFCOUNT),0)),"^",3)
  1.  F Z=1,2,3,4,5,8,9 I $P(Y,X,Z)="" S $P(Y,X,Z)=HLQ
  1.  I $G(VAFCOUNT) D
  1.  .S $P(Y,HLFS,2)=$P(Y,X,9)
  1.  Q Y