source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHLPI2.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1VAFHLPI2 ;ALB/BWF - EXTENSION OF PID SEGMENT BUILDER ;23-APR-2003
2 ;;5.3;Registration;**508**;Aug 13, 1993
3 ;
4 Q
5 ;
6SEQ11(TYPE,HLQ) ;Patient Address (seq #11)
7 ;
8 ;Input : TYPE - Qualifiers denoting which type of address to return
9 ; P = Include permanent address
10 ; C = Include confidential address
11 ; "" = Only return permanent address (default)
12 ; HLQ - HL7 null designation
13 ;Assumed: VAPA() - Output of call to ADD^VADPT
14 ;Output : None - sets nodes in array VAFY
15 ; VAFY(11,1,1..X) = Primary address
16 ; VAFY(11,2..X,1..X) = Confidential Address
17 ;Notes : Validity and existance of input is assumed
18 ; : Assumes no individual component is greater than 245
19 ; characters long
20 ; : If TYPE = "", line 3 of the permanent address will be added
21 ; to the end of line 2 (instead of being returned separately)
22 ;
23 ;Declare variables
24 N NODE
25 K VAFY(11)
26 I '$D(HLQ) S HLQ=$C(34,34)
27 S TYPE=$G(TYPE)
28 I (TYPE'["P"),(TYPE'["C") S TYPE=""
29 S NODE=1
30 I TYPE="" D PERMADD
31 I (TYPE["P") D PERMADD
32 I (TYPE["C") D CONFADD
33 Q
34 ;
35PERMADD ; Put permanent address into output array
36 N X
37 S VAFY(11,NODE,1)=$S(VAPA(1)'="":VAPA(1),1:HLQ)
38 S VAFY(11,NODE,2)=$S(VAPA(2)'="":VAPA(2),1:HLQ)
39 I TYPE'["P" S X=VAPA(2)_" "_VAPA(3),VAFY(11,NODE,2)=$S(X'=" ":X,1:HLQ)
40 S VAFY(11,NODE,3)=$S(VAPA(4)'="":VAPA(4),1:HLQ)
41 S X=$P($G(^DIC(5,+VAPA(5),0)),"^",2)
42 S VAFY(11,NODE,4)=$S(X'="":X,1:HLQ)
43 S VAFY(11,NODE,5)=$S($P(VAPA(6),U,1)'="":$P(VAPA(6),U,1),1:HLQ)
44 I TYPE["P" D
45 .S VAFY(11,NODE,6)=""
46 .S VAFY(11,NODE,7)="P"
47 .S VAFY(11,NODE,8)=$S(VAPA(3)'="":VAPA(3),1:HLQ)
48 .S X=$P($G(^DIC(5,+VAPA(5),1,+VAPA(7),0)),"^",3)
49 .S VAFY(11,NODE,9)=$S(X'="":X,1:HLQ)
50 S NODE=NODE+1
51 Q
52CONFADD ;Put confidential address into output array
53 N LOOP,ADDTYPE,CSTATE,CCOUNTY,CSTDATE,CENDATE
54 S CSTATE=$P($G(^DIC(5,+VAPA(17),0)),"^",2)
55 S CCOUNTY=$P($G(^DIC(5,+VAPA(17),1,+VAPA(19),0)),"^",3)
56 S CSTDATE=$$HLDATE^HLFNC($P(VAPA(20),"^",1))
57 S CENDATE=$$HLDATE^HLFNC($P(VAPA(21),"^",1))
58 F ADDTYPE=1:1:5 D
59 .I +VAPA(12) I $P($G(VAPA(22,ADDTYPE)),"^",3)="Y" D CONFACT Q
60 .D CONFIN
61 Q
62CONFACT ;Active confidential address type
63 S VAFY(11,NODE,1)=$S(VAPA(13)'="":VAPA(13),1:HLQ)
64 S VAFY(11,NODE,2)=$S(VAPA(14)'="":VAPA(14),1:HLQ)
65 S VAFY(11,NODE,3)=$S(VAPA(16)'="":VAPA(16),1:HLQ)
66 S VAFY(11,NODE,4)=$S(CSTATE'="":CSTATE,1:HLQ)
67 S X=$P(VAPA(18),"^",1),VAFY(11,NODE,5)=$S(X'="":X,1:HLQ)
68 S VAFY(11,NODE,6)=""
69 S VAFY(11,NODE,7)=$S(ADDTYPE=1:"VACAE",ADDTYPE=2:"VACAA",ADDTYPE=3:"VACAC",ADDTYPE=4:"VACAM",ADDTYPE=5:"VACAO",1:HLQ)
70 S VAFY(11,NODE,8)=$S(VAPA(15)'="":VAPA(15),1:HLQ)
71 S VAFY(11,NODE,9)=$S(CCOUNTY'="":CCOUNTY,1:HLQ)
72 S VAFY(11,NODE,10)=""
73 S VAFY(11,NODE,11)=""
74 S VAFY(11,NODE,12,1)=$S(CSTDATE'="":CSTDATE,1:HLQ)
75 S VAFY(11,NODE,12,2)=$S(CENDATE'="":CENDATE,1:HLQ)
76 S NODE=NODE+1
77 Q
78CONFIN ;Inactive confidential address type
79 N X
80 F X=1,2,3,4,5,8,9 S VAFY(11,NODE,X)=HLQ
81 F X=6,10,11 S VAFY(11,NODE,X)=""
82 S VAFY(11,NODE,7)=$S(ADDTYPE=1:"VACAE",ADDTYPE=2:"VACAA",ADDTYPE=3:"VACAC",ADDTYPE=4:"VACAM",ADDTYPE=5:"VACAO",1:HLQ)
83 S VAFY(11,NODE,12,1)=HLQ
84 S VAFY(11,NODE,12,2)=HLQ
85 S NODE=NODE+1
86 Q
Note: See TracBrowser for help on using the repository browser.