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

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1VAFHLZDP ;ALB/MLI,TDM - Creates HL7 segments ZDP and/or ZIC ; 9/26/05 3:32pm
2 ;;5.3;Registration;**33,653**;Aug 13, 1993;Build 2
3 ;
4 ; This routine will return the ZDP (dependent) segment for the
5 ; dependent specified by the variable VAFIEN.
6 ;
7EN(VAFIEN,VAFSTR,VAFNUM,VAFMTDT) ; Call to produce ZDP segment for given individual
8 ;
9 ;
10 ; Input: VAFIEN as IEN of PATIENT RELATION (#408.12) file
11 ; VAFSTR as string of desired fields separated by commas
12 ; VAFNUM as the number desired for the set id (default = 1)
13 ; VAFMTDT as the date of the means test (default = DT)
14 ;
15 ; Output: String of fields forming HL7 ZDP segment
16 ;
17 N NODE,NODE0,X,VAFY,NODE1
18 S NODE=$$DEM^DGMTU1(+$G(VAFIEN))
19 I $G(VAFSTR)']"" G QUIT
20 S $P(VAFY,HLFS,7)="",VAFSTR=","_VAFSTR_","
21 S $P(VAFY,HLFS,1)=$S($G(VAFNUM):VAFNUM,1:1)
22 S VAFMTDT=$S($G(VAFMTDT):VAFMTDT,1:DT)
23 I VAFSTR[",2," S X=$$HLNAME^HLFNC($P(NODE,"^",1)),$P(VAFY,HLFS,2)=$S(X]"":X,1:HLQ) ; name
24 I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(NODE,"^",2)]"":$P(NODE,"^",2),1:HLQ) ; sex
25 I VAFSTR[",4," S X=$$HLDATE^HLFNC($P(NODE,"^",3)),$P(VAFY,HLFS,4)=$S(X]"":X,1:HLQ) ; dob
26 I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($P(NODE,"^",9)]"":$P(NODE,"^",9),1:HLQ) ; ssn
27 I VAFSTR[",6," D
28 .S NODE0=$G(^DGPR(408.12,+$G(VAFIEN),0))
29 .S $P(VAFY,HLFS,6)=$S($P(NODE0,"^",2)]"":$P(NODE0,"^",2),1:HLQ) ; relationship to patient
30 I VAFSTR[",7," S $P(VAFY,HLFS,7)=+$G(VAFIEN) ; internal entry number
31 I VAFSTR[",8,",$$REL^DGMTU1(VAFIEN)="SPOUSE" D
32 .S NODE1=$$NODE1(+$G(VAFIEN))
33 .S $P(VAFY,HLFS,8)=$S($P(NODE1,"^")]"":$P(NODE1,"^"),1:HLQ) ; spouse's maiden name
34 I VAFSTR[",9," D
35 .S X=-($E(VAFMTDT,1,3)-1_"1231.9"),X=-$O(^DGPR(408.12,+$G(VAFIEN),"E","AID",X))
36 .S X=$$HLDATE^HLFNC(X),$P(VAFY,HLFS,9)=$S(X]"":X,1:HLQ) ; effective date
37 I VAFSTR[",10," S $P(VAFY,HLFS,10)=$S($P(NODE,"^",10)]"":$P(NODE,"^",10),1:HLQ) ; pseudo ssn reason
38 ;
39QUIT Q "ZDP"_HLFS_$G(VAFY)
40 ;
41NODE1(DGPRI) ;GET Node 1 of Patient Relation
42 N DGVPI,DGVP1
43 S DGVPI=$P($G(^DGPR(408.12,DGPRI,0)),"^",3)
44 I DGVPI]"" S DGVP1=$G(@("^"_$P(DGVPI,";",2)_+DGVPI_",1)"))
45 Q $S($G(DGVP1)]"":DGVP1,1:"")
Note: See TracBrowser for help on using the repository browser.