| 1 | VAFHLZDP ;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 | ;
|
|---|
| 7 | EN(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 | ;
|
|---|
| 39 | QUIT Q "ZDP"_HLFS_$G(VAFY)
|
|---|
| 40 | ;
|
|---|
| 41 | NODE1(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:"")
|
|---|
