Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLPID.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLPID.m
r613 r623 1 VAFHLPID ;ALB/MLI/ESD - Create generic PID segment ; 21 Nov 2002 3:13 PM 2 ;;5.3;Registration;**68,94,415,508,749**;Aug 13, 1993;Build 10 3 ; 4 ; This routine returns the HL7 defined PID segment with its 5 ; mappings to DHCP PATIENT file fields. 6 ; 7 EN(DFN,VAFSTR,VAFNUM,PTID) ; returns PID segment 8 ; Input - DFN as internal entry number of the PATIENT file 9 ; VAFSTR as string of fields requested separated by commas 10 ; VAFNUM as sequential number for SET ID (default=1) 11 ; PTID is flag denoting which Patient ID (seq 3) to use 12 ; 0 - Use DFN formatted as data type CK (default) 13 ; 1 - Use ICN 14 ; 2 - Use DFN formatted as data type CX 15 ; 3 - Use SSN (with dashes) 16 ; 17 ; ****Also assumes all HL7 variables returned from**** 18 ; INIT^HLTRANS are defined 19 ; 20 ; Output - String containing the desired components of the PID segment 21 ; VAFPID(n) - if the string is longer than 245, the remaining 22 ; characters will be returned in VAFPID(n) where 23 ; n is a sequential number beginning with 1 24 ; 25 ; WARNING: This routine makes external calls to VADPT. Non-namespaced 26 ; variables may be altered. 27 ; 28 N I,VAFY,VA,VADM,X,X1,Y,OUTPUT,DGNAME,DGMMN,VAPA ; calls VADPT...have to NEW 29 S VAFSTR=$G(VAFSTR) ; if not defined, just return required fields 30 S DFN=$G(DFN) 31 I DFN']"" G QUIT 32 ;Get demographics and permanent address 33 S VAPA("P")="" D 4^VADPT 34 S VAFSTR=","_VAFSTR_"," 35 K VAFY 36 ;Set ID (#1) 37 I VAFSTR[",1," S VAFY(1)=$S($G(VAFNUM):VAFNUM,1:1) 38 ;External ID (#2) 39 I VAFSTR[",2," S X=$G(VA("PID")),VAFY(2)=$S(X]"":$$M10^HLFNC(X),1:HLQ) 40 ;Patient ID (#3 - req) 41 S PTID=+$G(PTID) 42 I 'PTID S VAFY(3)=$$M10^HLFNC(DFN) 43 I PTID D 44 .S X=$S(PTID=1:"NI",PTID=2:"PI",PTID=3:"SS") 45 .S VAFY(3)=$$SEQ3^VAFHLPI1(DFN,X,HLECH,HLQ) 46 ;Alternate ID (#4) 47 I VAFSTR[",4," S X=$G(VA("BID")),VAFY(4)=$S(X]"":X,1:HLQ) 48 ;Name (#5 - req) 49 S DGNAME("FILE")=2,DGNAME("IENS")=DFN,DGNAME("FIELD")=.01 50 S X=$$HLNAME^XLFNAME(.DGNAME,"",$E(HLECH)),VAFY(5)=$S(X]"":X,1:HLQ) 51 ;Mother's maiden name (#6) 52 I VAFSTR[",6," D 53 .S DGMMN("FILE")=2,DGMMN("IENS")=DFN,DGMMN("FIELD")=.2403 54 .S X=$$HLNAME^XLFNAME(.DGMMN,"",$E(HLECH)),VAFY(6)=$S(X]"":X,1:HLQ) 55 ;Date of birth (#7) 56 I VAFSTR[",7," S VAFY(7)=$$HLDATE^HLFNC(+VADM(3)) 57 ;Sex (#8) 58 I VAFSTR[",8," S X=$P(VADM(5),"^",1),VAFY(8)=$S("^M^F^"[("^"_X_"^"):X,1:"U") 59 ;Race (#10) 60 I VAFSTR[10 D 61 .N HOW 62 .S Y=$F(VAFSTR,"10") 63 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 64 .D SEQ10^VAFHLPI1(HOW,HLQ) 65 ;Address (#11) 66 I VAFSTR[11 D 67 .N HOW 68 .S Y=$F(VAFSTR,"11") 69 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 70 .D SEQ11^VAFHLPI2(HOW,HLQ) 71 ;County (#12) 72 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) 73 S X=$G(^DPT(DFN,.13)) 74 ;Home phone (#13) 75 I VAFSTR[13 S X1=$$HLPHONE^HLFNC($P(X,"^",1)),VAFY(13)=$S(X1]"":X1,1:HLQ) 76 ;Business phone (#14) 77 I VAFSTR[14 S X1=$$HLPHONE^HLFNC($P(X,"^",2)),VAFY(14)=$S(X1]"":X1,1:HLQ) 78 ;Marital status (#16) 79 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) 80 ;Religious preference (#17) (if blank send 29 (UNKNOWN)) 81 I VAFSTR[17 S X=$P($G(^DIC(13,+VADM(9),0)),"^",4),VAFY(17)=$S(X]"":X,1:29) 82 ;SSN (#19) 83 I VAFSTR[19 S X=$P(VADM(2),"^",1),VAFY(19)=$S(X]"":X,1:HLQ) 84 ;Ethnicity (#22) 85 I VAFSTR[22 D 86 .N HOW 87 .S Y=$F(VAFSTR,"22") 88 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 89 .D SEQ22^VAFHLPI1(HOW,HLQ) 90 ; 91 QUIT D KVA^VADPT 92 D MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID) 93 Q OUTPUT 1 VAFHLPID ;ALB/MLI/ESD - Create generic PID segment ; 21 Nov 2002 3:13 PM 2 ;;5.3;Registration;**68,94,415,508**;Aug 13, 1993 3 ; 4 ; This routine returns the HL7 defined PID segment with its 5 ; mappings to DHCP PATIENT file fields. 6 ; 7 EN(DFN,VAFSTR,VAFNUM,PTID) ; returns PID segment 8 ; Input - DFN as internal entry number of the PATIENT file 9 ; VAFSTR as string of fields requested separated by commas 10 ; VAFNUM as sequential number for SET ID (default=1) 11 ; PTID is flag denoting which Patient ID (seq 3) to use 12 ; 0 - Use DFN formatted as data type CK (default) 13 ; 1 - Use ICN 14 ; 2 - Use DFN formatted as data type CX 15 ; 3 - Use SSN (with dashes) 16 ; 17 ; ****Also assumes all HL7 variables returned from**** 18 ; INIT^HLTRANS are defined 19 ; 20 ; Output - String containing the desired components of the PID segment 21 ; VAFPID(n) - if the string is longer than 245, the remaining 22 ; characters will be returned in VAFPID(n) where 23 ; n is a sequential number beginning with 1 24 ; 25 ; WARNING: This routine makes external calls to VADPT. Non-namespaced 26 ; variables may be altered. 27 ; 28 N I,VAFY,VA,VADM,X,X1,Y,OUTPUT,DGNAME,VAPA ; calls VADPT...have to NEW 29 S VAFSTR=$G(VAFSTR) ; if not defined, just return required fields 30 S DFN=$G(DFN) 31 I DFN']"" G QUIT 32 ;Get demographics and permanent address 33 S VAPA("P")="" D 4^VADPT 34 S VAFSTR=","_VAFSTR_"," 35 K VAFY 36 ;Set ID (#1) 37 I VAFSTR[",1," S VAFY(1)=$S($G(VAFNUM):VAFNUM,1:1) 38 ;External ID (#2) 39 I VAFSTR[",2," S X=$G(VA("PID")),VAFY(2)=$S(X]"":$$M10^HLFNC(X),1:HLQ) 40 ;Patient ID (#3 - req) 41 S PTID=+$G(PTID) 42 I 'PTID S VAFY(3)=$$M10^HLFNC(DFN) 43 I PTID D 44 .S X=$S(PTID=1:"NI",PTID=2:"PI",PTID=3:"SS") 45 .S VAFY(3)=$$SEQ3^VAFHLPI1(DFN,X,HLECH,HLQ) 46 ;Alternate ID (#4) 47 I VAFSTR[",4," S X=$G(VA("BID")),VAFY(4)=$S(X]"":X,1:HLQ) 48 ;Name (#5 - req) 49 S DGNAME("FILE")=2,DGNAME("IENS")=DFN,DGNAME("FIELD")=.01 50 S X=$$HLNAME^XLFNAME(.DGNAME,"",$E(HLECH)),VAFY(5)=$S(X]"":X,1:HLQ) 51 ;Mother's maiden name (#6) 52 I VAFSTR[",6," S X=$P($G(^DPT(DFN,.24)),"^",3),VAFY(6)=$S(X]"":X,1:HLQ) 53 ;Date of birth (#7) 54 I VAFSTR[",7," S VAFY(7)=$$HLDATE^HLFNC(+VADM(3)) 55 ;Sex (#8) 56 I VAFSTR[",8," S X=$P(VADM(5),"^",1),VAFY(8)=$S("^M^F^"[("^"_X_"^"):X,1:"U") 57 ;Race (#10) 58 I VAFSTR[10 D 59 .N HOW 60 .S Y=$F(VAFSTR,"10") 61 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 62 .D SEQ10^VAFHLPI1(HOW,HLQ) 63 ;Address (#11) 64 I VAFSTR[11 D 65 .N HOW 66 .S Y=$F(VAFSTR,"11") 67 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 68 .D SEQ11^VAFHLPI2(HOW,HLQ) 69 ;County (#12) 70 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) 71 S X=$G(^DPT(DFN,.13)) 72 ;Home phone (#13) 73 I VAFSTR[13 S X1=$$HLPHONE^HLFNC($P(X,"^",1)),VAFY(13)=$S(X1]"":X1,1:HLQ) 74 ;Business phone (#14) 75 I VAFSTR[14 S X1=$$HLPHONE^HLFNC($P(X,"^",2)),VAFY(14)=$S(X1]"":X1,1:HLQ) 76 ;Marital status (#16) 77 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) 78 ;Religious preference (#17) (if blank send 29 (UNKNOWN)) 79 I VAFSTR[17 S X=$P($G(^DIC(13,+VADM(9),0)),"^",4),VAFY(17)=$S(X]"":X,1:29) 80 ;SSN (#19) 81 I VAFSTR[19 S X=$P(VADM(2),"^",1),VAFY(19)=$S(X]"":X,1:HLQ) 82 ;Ethnicity (#22) 83 I VAFSTR[22 D 84 .N HOW 85 .S Y=$F(VAFSTR,"22") 86 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 87 .D SEQ22^VAFHLPI1(HOW,HLQ) 88 ; 89 QUIT D KVA^VADPT 90 D MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID) 91 Q OUTPUT
Note:
See TracChangeset
for help on using the changeset viewer.
