[628] | 1 | VAFCQRY3 ;BIR/CMC-CONT TO BLD PID 2.4 SEGMENT ;3/2/04
|
---|
| 2 | ;;5.3;Registration;**575,707**;Aug 13, 1993;Build 14
|
---|
| 3 | ;
|
---|
| 4 | CONT(DFN,APID,PID,HL,HLES,SARY,SEQ,ERROR,REP,COMP,SSN,VAFCMN) ; continue to bld pid segment
|
---|
| 5 | ADDR ;had to split routine
|
---|
| 6 | I $D(SARY(11))!(SEQ="ALL") S APID(12)="" D
|
---|
| 7 | .I $D(^DPT(DFN,0)) D
|
---|
| 8 | ..;address info
|
---|
| 9 | ..N COUNTY K HL7STRG
|
---|
| 10 | ..S HL7STRG=$$GET1^DIQ(2,DFN_",",.111) D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES)
|
---|
| 11 | ..S $P(APID(12),COMP)=HL7STRG I $P(APID(12),COMP)="" S $P(APID(12),COMP)=HL("Q") K HL7STRG
|
---|
| 12 | ..K HL7STRG S HL7STRG=$$GET1^DIQ(2,DFN_",",.112) D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) ;**707 add HL7TXT call
|
---|
| 13 | ..S $P(APID(12),COMP,2)=HL7STRG I $P(APID(12),COMP,2)="" S $P(APID(12),COMP,2)=HL("Q")
|
---|
| 14 | ..K HL7STRG S HL7STRG=$$GET1^DIQ(2,DFN_",",.113) D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) ;**707 add HL7TXT call
|
---|
| 15 | ..S $P(APID(12),COMP,8)=HL7STRG I $P(APID(12),COMP,8)="" S $P(APID(12),COMP,8)=HL("Q")
|
---|
| 16 | ..K HL7STRG
|
---|
| 17 | ..; **707 changes to include foreign address
|
---|
| 18 | ..N CNTRY S CNTRY=$$GET1^DIQ(2,DFN_",",.1173) ;RETURN EXTERNAL VALUE from country code file #779.004 field .01
|
---|
| 19 | ..I CNTRY="US" S CNTRY="USA"
|
---|
| 20 | ..S HL7STRG=$$GET1^DIQ(2,DFN_",",.114) D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S $P(APID(12),COMP,3)=HL7STRG I $P(APID(12),COMP,3)="" S $P(APID(12),COMP,3)=HL("Q")
|
---|
| 21 | ..I CNTRY=""!(CNTRY="USA") D
|
---|
| 22 | ...;have USA address
|
---|
| 23 | ...S STATEIEN=$$GET1^DIQ(2,DFN_",",.115,"I") S $P(APID(12),COMP,4)=$$GET1^DIQ(5,+STATEIEN_",",1)
|
---|
| 24 | ...I $P(APID(12),COMP,4)="" S $P(APID(12),COMP,4)=HL("Q")
|
---|
| 25 | ...S $P(APID(12),COMP,5)=$$GET1^DIQ(2,DFN_",",.1112) I $P(APID(12),COMP,5)="" S $P(APID(12),COMP,5)=HL("Q")
|
---|
| 26 | ...S $P(APID(12),COMP,6)=CNTRY I CNTRY="" S $P(APID(12),COMP,6)=HL("Q") ;country
|
---|
| 27 | ..I CNTRY'="",(CNTRY'="USA") D
|
---|
| 28 | ...;Check for foreign address fields
|
---|
| 29 | ...S $P(APID(12),COMP,4)=$P($G(^DPT(DFN,.11)),"^",8) I $P(APID(12),COMP,4)="" S $P(APID(12),COMP,4)=HL("Q") ;province
|
---|
| 30 | ...S $P(APID(12),COMP,5)=$P($G(^DPT(DFN,.11)),"^",9) I $P(APID(12),COMP,5)="" S $P(APID(12),COMP,5)=HL("Q") ;postal code
|
---|
| 31 | ...S $P(APID(12),COMP,6)=CNTRY I CNTRY="" S $P(APID(12),COMP,6)=HL("Q") ;COUNTRY
|
---|
| 32 | ...; ***707 end of code
|
---|
| 33 | ..S $P(APID(12),COMP,7)="P"
|
---|
| 34 | BADADDR ..;BAD ADDRESS INDICATOR (if present overwrite the "P" ermanent type with the Bad Address type
|
---|
| 35 | ..I $D(^DPT(DFN,.11)) N BADADR S BADADR=$P(^DPT(DFN,.11),"^",16) I BADADR'="" S $P(APID(12),COMP,7)="VAB"_BADADR
|
---|
| 36 | ..S COUNTY=$$GET1^DIQ(2,DFN_",",.117) I COUNTY="" S COUNTY=HL("Q") ;**648 add COUNTY Code to PID-11, retained in PID-12 also
|
---|
| 37 | ..S $P(APID(12),COMP,9)=COUNTY ;county code
|
---|
| 38 | ..;place of birth information
|
---|
| 39 | ..S CITY=$$GET1^DIQ(2,DFN_",",.092) S HL7STRG=CITY D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S CITY=HL7STRG D
|
---|
| 40 | ...N X
|
---|
| 41 | ...I $G(CITY)'="" S $P(X,COMP,3)=CITY
|
---|
| 42 | ...I $G(CITY)="" S $P(X,COMP,3)=HL("Q")
|
---|
| 43 | ...S STATEIEN=$$GET1^DIQ(2,DFN_",",.093,"I") S STATE=$$GET1^DIQ(5,+STATEIEN_",",1) D
|
---|
| 44 | ....I $G(STATE)'="" S $P(X,COMP,4)=STATE
|
---|
| 45 | ....I $G(STATE)="" S $P(X,COMP,4)=HL("Q")
|
---|
| 46 | ... S $P(X,COMP,7)="N",APID(12)=$G(APID(12))_REP_X
|
---|
| 47 | CONF .;CONFIDENTIAL ADDRESS
|
---|
| 48 | .I $D(^DPT(DFN,.141)) N CNFADD S CNFADD=$$GET1^DIQ(2,DFN_",",.14105) D
|
---|
| 49 | ..N LINE1,LINE2,LINE3,STATEIEN,STATE,CNTRY,ZIP,LVL,LNGTH,NXT,CNFEND,CNFSTRT,SUBCOMP,CNTY,CITY
|
---|
| 50 | ..S SUBCOMP=$E(HL("ECH"),4)
|
---|
| 51 | ..S LINE1=$$GET1^DIQ(2,DFN_",",.1411) S HL7STRG=LINE1 D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S LINE1=HL7STRG
|
---|
| 52 | ..S LINE2=$$GET1^DIQ(2,DFN_",",.1412) S HL7STRG=LINE2 D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S LINE2=HL7STRG
|
---|
| 53 | ..S LINE3=$$GET1^DIQ(2,DFN_",",.1413) S HL7STRG=LINE3 D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S LINE3=HL7STRG
|
---|
| 54 | ..S CNFSTRT=$$FMTHL7^XLFDT($$GET1^DIQ(2,DFN_",",.1417,"I")),CNFEND=$$FMTHL7^XLFDT($$GET1^DIQ(2,DFN_",",.1418,"I"))
|
---|
| 55 | ..S CITY=$$GET1^DIQ(2,DFN_",",.1414) S HL7STRG=CITY D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S CITY=HL7STRG
|
---|
| 56 | ..S CNTRY=$$GET1^DIQ(2,DFN_",",.14116)
|
---|
| 57 | ..;if foriegn address
|
---|
| 58 | ..I CNTRY=""!(CNTRY="USA")!(CNTRY="US") S:CNTRY="US" CNTRY="USA" S STATEIEN=$$GET1^DIQ(2,DFN_",",.1415,"I") S STATE=$$GET1^DIQ(5,+STATEIEN_",",1),CNTY=$$GET1^DIQ(2,DFN_",",.14111),ZIP=$$GET1^DIQ(2,DFN_",",.1416)
|
---|
| 59 | ..E S STATE=$$GET1^DIQ(2,DFN_",",.14114),ZIP=$$GET1^DIQ(2,DFN_",",.14115) ;if USA address or null assume USA address
|
---|
| 60 | ..S LVL=0,LNGTH=$L(APID(12))
|
---|
| 61 | ..I $D(^DPT(DFN,.14,0)) N CNFTYP S CNFTYP=0 F S CNFTYP=$O(^DPT(DFN,.14,CNFTYP)) Q:'CNFTYP N CNFTYPA S CNFTYPA=$P(^DPT(DFN,.14,CNFTYP,0),"^",2) I CNFTYPA="Y" S CNFTYPA=$P(^DPT(DFN,.14,CNFTYP,0),"^") D
|
---|
| 62 | ...S NXT=""
|
---|
| 63 | ...S $P(NXT,COMP)=$S(LINE1'="":LINE1,1:HL("Q"))
|
---|
| 64 | ...S $P(NXT,COMP,2)=$S(LINE2'="":LINE2,1:HL("Q"))
|
---|
| 65 | ...S $P(NXT,COMP,8)=$S(LINE3'="":LINE3,1:HL("Q"))
|
---|
| 66 | ...S $P(NXT,COMP,3)=$S(CITY'="":CITY,1:HL("Q"))
|
---|
| 67 | ...S $P(NXT,COMP,4)=$S($G(STATE)'="":STATE,1:HL("Q"))
|
---|
| 68 | ...S $P(NXT,COMP,5)=$S(ZIP'="":ZIP,1:HL("Q"))
|
---|
| 69 | ...S $P(NXT,COMP,6)=$S(CNTRY'="":CNTRY,1:HL("Q"))
|
---|
| 70 | ...S $P(NXT,COMP,7)=$S(CNFTYPA=1:"VACAE",CNFTYPA=2:"VACAA",CNFTYPA=3:"VACAC",CNFTYPA=4:"VACAM",CNFTYPA=5:"VACAO",1:HL("Q"))
|
---|
| 71 | ...S $P(NXT,COMP,9)=$S($G(CNTY)'="":CNTY,1:HL("Q"))
|
---|
| 72 | ...S $P(NXT,COMP,12)=CNFSTRT_SUBCOMP_CNFEND
|
---|
| 73 | ...S NXT=REP_NXT
|
---|
| 74 | ...I LVL=0 D
|
---|
| 75 | ....I $L(APID(12)_NXT)'>244 S APID(12)=APID(12)_NXT Q
|
---|
| 76 | ....I $L(APID(12)_NXT)>244 S LVL=1 S LNGTH=244-$L(APID(12)),APID(12)=APID(12)_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT))
|
---|
| 77 | ...I LVL>0 D
|
---|
| 78 | ....I $L($G(APID(12,LVL))_NXT)'>245 S APID(12,LVL)=$G(APID(12,LVL))_NXT Q
|
---|
| 79 | ....I $L($G(APID(12,LVL))_NXT)>245 S LNGTH=244-$L(APID(12,LVL)),APID(12,LVL)=APID(12,LVL)_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT)) S LVL=LVL+1 S APID(12,LVL)=NXT
|
---|
| 80 | I $D(SARY(12))!(SEQ="ALL") S APID(13)=$$GET1^DIQ(2,DFN_",",.117) I APID(13)="" S APID(13)=HL("Q") ;county code **648 backwards compatibility only
|
---|
| 81 | PHONE I $D(SARY(13))!($D(SARY(14)))!(SEQ="ALL") D
|
---|
| 82 | .;**707 change PID-13 to have home and work phones, cell, pager and e-mail address with the components
|
---|
| 83 | .N PHONEN,HNUM,WNUM,EMAIL,CELL,PAGER
|
---|
| 84 | .S PHONEN=$G(^DPT(DFN,.13))
|
---|
| 85 | .; **707 change to ensure that null doesn't end up for any of these fields cmc 12/7/06
|
---|
| 86 | .S HNUM=$P(PHONEN,"^") I HNUM'="" S HNUM=$$HLPHONE^HLFNC(HNUM) I HNUM'="" S HL7STRG=HNUM D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S HNUM=HL7STRG_COMP_"PRN"_COMP_"PH"
|
---|
| 87 | .S WNUM=$P(PHONEN,"^",2) I WNUM'="" S WNUM=$$HLPHONE^HLFNC(WNUM) I WNUM'="" S HL7STRG=WNUM D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S WNUM=HL7STRG_COMP_"WPN"_COMP_"PH"
|
---|
| 88 | .S CELL=$P(PHONEN,"^",4) I CELL'="" S CELL=$$HLPHONE^HLFNC(CELL) I CELL'="" S HL7STRG=CELL D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S CELL=HL7STRG_COMP_"ORN"_COMP_"CP"
|
---|
| 89 | .S PAGER=$P(PHONEN,"^",5) I PAGER'="" S PAGER=$$HLPHONE^HLFNC(PAGER) I PAGER'="" S HL7STRG=PAGER D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S PAGER=HL7STRG_COMP_"BPN"_COMP_"BP"
|
---|
| 90 | .S EMAIL=$P(PHONEN,"^",3) I EMAIL'="" S HL7STRG=EMAIL D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S EMAIL=COMP_"NET"_COMP_"INTERNET"_COMP_HL7STRG
|
---|
| 91 | .I HNUM'="" S APID(14)=HNUM
|
---|
| 92 | .I WNUM'="",APID(14)'="" S APID(14)=APID(14)_REP_WNUM
|
---|
| 93 | .I WNUM'="",APID(14)="" S APID(14)=WNUM
|
---|
| 94 | .I CELL'="",APID(14)'="" S APID(14)=APID(14)_REP_CELL
|
---|
| 95 | .I CELL'="",APID(14)="" S APID(14)=CELL
|
---|
| 96 | .I PAGER'="",APID(14)'="" S APID(14)=APID(14)_REP_PAGER
|
---|
| 97 | .I PAGER'="",APID(14)="" S APID(14)=PAGER
|
---|
| 98 | .I EMAIL'="",APID(14)'="" S APID(14)=APID(14)_REP_EMAIL
|
---|
| 99 | .I EMAIL'="",APID(14)="" S APID(14)=EMAIL
|
---|
| 100 | .I APID(14)="" S APID(14)=HL("Q")
|
---|
| 101 | I $D(SARY(14))!(SEQ="ALL") N WNUM S WNUM=$P($G(^DPT(DFN,.13)),"^",2) S WNUM=$$HLPHONE^HLFNC(WNUM) S HL7STRG=WNUM D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S APID(15)=HL7STRG I APID(15)="" S APID(15)=HL("Q")
|
---|
| 102 | ;**707 keep work# in PID-14 for backwards compatability but should use PID-13 to get work#
|
---|
| 103 | I $D(SARY(19))!(SEQ="ALL") S APID(20)=SSN ;ssn passed in PID-3
|
---|
| 104 | I $D(SARY(23))!(SEQ="ALL") D
|
---|
| 105 | .S CITY=$$GET1^DIQ(2,DFN_",",.092) S HL7STRG=CITY D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S CITY=HL7STRG
|
---|
| 106 | .S STATEIEN=$$GET1^DIQ(2,DFN_",",.093,"I") S STATE=$$GET1^DIQ(5,+STATEIEN_",",1) D
|
---|
| 107 | .I CITY'=""&(STATE'="") S APID(24)=CITY_" "_STATE ;place of birth (not used) use PID-11 with an 'N' instead
|
---|
| 108 | .I CITY=""&(STATE="") S APID(24)=HL("Q")
|
---|
| 109 | D CONT^VAFCQRY4(DFN,.APID,.PID,.HL,HLES,.SARY,SEQ,.ERROR,REP,COMP)
|
---|
| 110 | ;**707 had to break routine
|
---|
| 111 | Q
|
---|