Changeset 623 for WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCPID.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/VAFCPID.m
r613 r623 1 VAFCPID ;ALB/MLI,PKE-Create generic PID segment ; 21 Nov 2002 3:13 PM 2 ;;5.3;Registration;**91,149,190,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) ; 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 ; 12 ; ****Also assumes all HL7 variables returned from**** 13 ; INIT^HLTRANS are defined 14 ; 15 ; Output - String containing the desired components of the PID segment 16 ; VAFPID(n) - if the string is longer than 245, the remaining 17 ; characters will be returned in VAFPID(n) where 18 ; n is a sequential number beginning with 1 19 ; 20 ; WARNING: This routine makes external calls to VADPT. Non-namespaced 21 ; variables may be altered. 22 ; 23 N I,VAFY,VA,VADM,X,X1,Y,OUTPUT,DGNAME,DGMMN,VAPA ; calls VADPT...have to NEW 24 S VAFSTR=$G(VAFSTR) ; if not defined, just return required fields 25 S DFN=$G(DFN) 26 I DFN']"" G QUIT 27 ;Get demographics and permanent address 28 S VAPA("P")="" D 4^VADPT 29 S VAFSTR=","_VAFSTR_"," 30 K VAFY 31 ;Set ID (#1) 32 I VAFSTR[",1," S VAFY(1)=$S($G(VAFNUM):VAFNUM,1:1) 33 ;External ID (#2 - always included) 34 S X=$$GETICN^MPIF001(DFN) S:(+X=-1) X="" S VAFY(2)=$S(X]"":X,1:HLQ) 35 ;Patient ID (#3 - req) 36 S VAFY(3)=$$M10^HLFNC(DFN) 37 ;Alternate ID (#4) 38 I VAFSTR[",4," S X=$G(VA("BID")),VAFY(4)=$S(X]"":X,1:HLQ) 39 ;Name (#5 - req) 40 S DGNAME("FILE")=2,DGNAME("IENS")=DFN,DGNAME("FIELD")=.01 41 S X=$$HLNAME^XLFNAME(.DGNAME,"",$E(HLECH)),VAFY(5)=$S(X]"":X,1:HLQ) 42 ;Mother's maiden name (#6) 43 I VAFSTR[",6," D 44 .S DGMMN("FILE")=2,DGMMN("IENS")=DFN,DGMMN("FIELD")=.2403 45 .S X=$$HLNAME^XLFNAME(.DGMMN,"",$E(HLECH)),VAFY(6)=$S(X]"":X,1:HLQ) 46 ;Date of birth (#7) 47 I VAFSTR[",7," S VAFY(7)=$$HLDATE^HLFNC(+VADM(3)) 48 ;Sex (#8) 49 I VAFSTR[",8," S X=$P(VADM(5),"^",1),VAFY(8)=$S("^M^F^"[("^"_X_"^"):X,1:"U") 50 ;Race (#10) 51 I VAFSTR[10 D 52 .N HOW 53 .S Y=$F(VAFSTR,"10") 54 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 55 .D SEQ10^VAFHLPI1(HOW,HLQ) 56 ;Address (#11) 57 I VAFSTR[11 D 58 .N HOW 59 .S Y=$F(VAFSTR,"11") 60 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 61 .D SEQ11^VAFHLPI2(HOW,HLQ) 62 ;County (#12) 63 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) 64 S X=$G(^DPT(DFN,.13)) 65 ;Home phone (#13) 66 I VAFSTR[13 S X1=$$HLPHONE^HLFNC($P(X,"^",1)),VAFY(13)=$S(X1]"":X1,1:HLQ) 67 ;Business phone (#14) 68 I VAFSTR[14 S X1=$$HLPHONE^HLFNC($P(X,"^",2)),VAFY(14)=$S(X1]"":X1,1:HLQ) 69 ;Marital status (#16) 70 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) 71 ;Religious preference (#17) (if blank send 29 (UNKNOWN)) 72 I VAFSTR[17 S X=$P($G(^DIC(13,+VADM(9),0)),"^",4),VAFY(17)=$S(X]"":X,1:29) 73 ;SSN (#19) 74 I VAFSTR[19 S X=$P(VADM(2),"^",1),VAFY(19)=$S(X]"":X,1:HLQ) 75 ;Ethnicity (#22) 76 I VAFSTR[22 D 77 .N HOW 78 .S Y=$F(VAFSTR,"22") 79 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 80 .D SEQ22^VAFHLPI1(HOW,HLQ) 81 ;Birth place (#23) 82 I VAFSTR[23 D 83 .N DGBC,DGBS 84 .S DGBC=$$GET1^DIQ(2,DFN,.092,"I") 85 .S DGBS=$$GET1^DIQ(2,DFN,.093,"E") 86 .S VAFY(23)=DGBC_" "_DGBS 87 ;Date of death (#29) & Death indicator (#30) (always included if dead) 88 S X=+VADM(6) I X D 89 .S VAFY(29)=$$HLDATE^HLFNC(X) 90 .S VAFY(30)="Y" 91 ; 92 QUIT D KVA^VADPT 93 D MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID) 94 Q OUTPUT 95 ; 96 ADDR(VAFADDR,VAFCOUNT) ;Return HL7 address 97 ; Input - VAFADDR as address in format: 98 ; line1^line2^line3^city^state^zip+4 99 ; VAFCOUNT as internal value of county (optional) 100 ; Output - HL7 v2.3 formatted Address_HLFS_County Code 101 ; 102 ; ****Also assumes all HL7 variables returned from**** 103 ; INIT^HLTRANS are defined 104 ; 105 N X,Y,Z S X=$E(HLECH) 106 ;Street address (line 1) 107 S $P(Y,X,1)=$P(VAFADDR,"^",1) 108 ;Other designation (line 2) 109 S $P(Y,X,2)=$P(VAFADDR,"^",2) 110 ;City 111 S $P(Y,X,3)=$P(VAFADDR,"^",4) 112 ;State 113 S $P(Y,X,4)=$P($G(^DIC(5,+$P(VAFADDR,"^",5),0)),"^",2) 114 ;Zip 115 S $P(Y,X,5)=$P(VAFADDR,"^",6) 116 ;Other geographic designation (line 3) 117 S $P(Y,X,8)=$P(VAFADDR,"^",3) 118 ;County 119 S $P(Y,X,9)=$P($G(^DIC(5,+$P(VAFADDR,"^",5),1,+$G(VAFCOUNT),0)),"^",3) 120 F Z=1,2,3,4,5,8,9 I $P(Y,X,Z)="" S $P(Y,X,Z)=HLQ 121 I $G(VAFCOUNT) D 122 .S $P(Y,HLFS,2)=$P(Y,X,9) 123 Q Y 1 VAFCPID ;ALB/MLI,PKE-Create generic PID segment ; 21 Nov 2002 3:13 PM 2 ;;5.3;Registration;**91,149,190,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) ; 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 ; 12 ; ****Also assumes all HL7 variables returned from**** 13 ; INIT^HLTRANS are defined 14 ; 15 ; Output - String containing the desired components of the PID segment 16 ; VAFPID(n) - if the string is longer than 245, the remaining 17 ; characters will be returned in VAFPID(n) where 18 ; n is a sequential number beginning with 1 19 ; 20 ; WARNING: This routine makes external calls to VADPT. Non-namespaced 21 ; variables may be altered. 22 ; 23 N I,VAFY,VA,VADM,X,X1,Y,OUTPUT,DGNAME,VAPA ; calls VADPT...have to NEW 24 S VAFSTR=$G(VAFSTR) ; if not defined, just return required fields 25 S DFN=$G(DFN) 26 I DFN']"" G QUIT 27 ;Get demographics and permanent address 28 S VAPA("P")="" D 4^VADPT 29 S VAFSTR=","_VAFSTR_"," 30 K VAFY 31 ;Set ID (#1) 32 I VAFSTR[",1," S VAFY(1)=$S($G(VAFNUM):VAFNUM,1:1) 33 ;External ID (#2 - always included) 34 S X=$$GETICN^MPIF001(DFN) S:(+X=-1) X="" S VAFY(2)=$S(X]"":X,1:HLQ) 35 ;Patient ID (#3 - req) 36 S VAFY(3)=$$M10^HLFNC(DFN) 37 ;Alternate ID (#4) 38 I VAFSTR[",4," S X=$G(VA("BID")),VAFY(4)=$S(X]"":X,1:HLQ) 39 ;Name (#5 - req) 40 S DGNAME("FILE")=2,DGNAME("IENS")=DFN,DGNAME("FIELD")=.01 41 S X=$$HLNAME^XLFNAME(.DGNAME,"",$E(HLECH)),VAFY(5)=$S(X]"":X,1:HLQ) 42 ;Mother's maiden name (#6) 43 I VAFSTR[",6," S X=$P($G(^DPT(DFN,.24)),"^",3),VAFY(6)=$S(X]"":X,1:HLQ) 44 ;Date of birth (#7) 45 I VAFSTR[",7," S VAFY(7)=$$HLDATE^HLFNC(+VADM(3)) 46 ;Sex (#8) 47 I VAFSTR[",8," S X=$P(VADM(5),"^",1),VAFY(8)=$S("^M^F^"[("^"_X_"^"):X,1:"U") 48 ;Race (#10) 49 I VAFSTR[10 D 50 .N HOW 51 .S Y=$F(VAFSTR,"10") 52 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 53 .D SEQ10^VAFHLPI1(HOW,HLQ) 54 ;Address (#11) 55 I VAFSTR[11 D 56 .N HOW 57 .S Y=$F(VAFSTR,"11") 58 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 59 .D SEQ11^VAFHLPI2(HOW,HLQ) 60 ;County (#12) 61 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) 62 S X=$G(^DPT(DFN,.13)) 63 ;Home phone (#13) 64 I VAFSTR[13 S X1=$$HLPHONE^HLFNC($P(X,"^",1)),VAFY(13)=$S(X1]"":X1,1:HLQ) 65 ;Business phone (#14) 66 I VAFSTR[14 S X1=$$HLPHONE^HLFNC($P(X,"^",2)),VAFY(14)=$S(X1]"":X1,1:HLQ) 67 ;Marital status (#16) 68 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) 69 ;Religious preference (#17) (if blank send 29 (UNKNOWN)) 70 I VAFSTR[17 S X=$P($G(^DIC(13,+VADM(9),0)),"^",4),VAFY(17)=$S(X]"":X,1:29) 71 ;SSN (#19) 72 I VAFSTR[19 S X=$P(VADM(2),"^",1),VAFY(19)=$S(X]"":X,1:HLQ) 73 ;Ethnicity (#22) 74 I VAFSTR[22 D 75 .N HOW 76 .S Y=$F(VAFSTR,"22") 77 .S HOW=$P($E(VAFSTR,Y,$F(VAFSTR,",",Y)),",",1) 78 .D SEQ22^VAFHLPI1(HOW,HLQ) 79 ;Birth place (#23) 80 I VAFSTR[23 D 81 .N DGBC,DGBS 82 .S DGBC=$$GET1^DIQ(2,DFN,.092,"I") 83 .S DGBS=$$GET1^DIQ(2,DFN,.093,"E") 84 .S VAFY(23)=DGBC_" "_DGBS 85 ;Date of death (#29) & Death indicator (#30) (always included if dead) 86 S X=+VADM(6) I X D 87 .S VAFY(29)=$$HLDATE^HLFNC(X) 88 .S VAFY(30)="Y" 89 ; 90 QUIT D KVA^VADPT 91 D MAKEIT^VAFHLU("PID",.VAFY,.OUTPUT,.VAFPID) 92 Q OUTPUT 93 ; 94 ADDR(VAFADDR,VAFCOUNT) ;Return HL7 address 95 ; Input - VAFADDR as address in format: 96 ; line1^line2^line3^city^state^zip+4 97 ; VAFCOUNT as internal value of county (optional) 98 ; Output - HL7 v2.3 formatted Address_HLFS_County Code 99 ; 100 ; ****Also assumes all HL7 variables returned from**** 101 ; INIT^HLTRANS are defined 102 ; 103 N X,Y,Z S X=$E(HLECH) 104 ;Street address (line 1) 105 S $P(Y,X,1)=$P(VAFADDR,"^",1) 106 ;Other designation (line 2) 107 S $P(Y,X,2)=$P(VAFADDR,"^",2) 108 ;City 109 S $P(Y,X,3)=$P(VAFADDR,"^",4) 110 ;State 111 S $P(Y,X,4)=$P($G(^DIC(5,+$P(VAFADDR,"^",5),0)),"^",2) 112 ;Zip 113 S $P(Y,X,5)=$P(VAFADDR,"^",6) 114 ;Other geographic designation (line 3) 115 S $P(Y,X,8)=$P(VAFADDR,"^",3) 116 ;County 117 S $P(Y,X,9)=$P($G(^DIC(5,+$P(VAFADDR,"^",5),1,+$G(VAFCOUNT),0)),"^",3) 118 F Z=1,2,3,4,5,8,9 I $P(Y,X,Z)="" S $P(Y,X,Z)=HLQ 119 I $G(VAFCOUNT) D 120 .S $P(Y,HLFS,2)=$P(Y,X,9) 121 Q Y
Note:
See TracChangeset
for help on using the changeset viewer.
