- VAFHLZDP ;ALB/MLI,TDM - Creates HL7 segments ZDP and/or ZIC ; 1/21/09 3:49pm
- ;;5.3;PIMS;**33,653,688,1015,1016**;JUN 30, 2012;Build 20
- ;
- ; This routine will return the ZDP (dependent) segment for the
- ; dependent specified by the variable VAFIEN.
- ;
- EN(VAFIEN,VAFSTR,VAFNUM,VAFMTDT,VAFIADT) ; Call to produce ZDP segment for given individual
- ;
- ;
- ; Input: VAFIEN as IEN of PATIENT RELATION (#408.12) file
- ; VAFSTR as string of desired fields separated by commas
- ; VAFNUM as the number desired for the set id (default = 1)
- ; VAFMTDT as the date of the means test (default = DT)
- ; VAFIADT as spouse/dependent inactivation date (optional)
- ;
- ; Output: String of fields forming HL7 ZDP segment
- ;
- N NODE,NODE0,X,VAFY,NODE1,CS,SS,RS
- S CS=$E(HLECH,1),SS=$E(HLECH,4),RS=$E(HLECH,2)
- S NODE=$$DEM^DGMTU1(+$G(VAFIEN)),NODE1=$$NODE1(+$G(VAFIEN))
- I $G(VAFSTR)']"" G QUIT
- S $P(VAFY,HLFS,14)="",VAFSTR=","_VAFSTR_","
- S $P(VAFY,HLFS,1)=$S($G(VAFNUM):VAFNUM,1:1)
- S VAFMTDT=$S($G(VAFMTDT):VAFMTDT,1:DT)
- I VAFSTR[",2," S X=$$HLNAME^HLFNC($P(NODE,"^",1)),$P(VAFY,HLFS,2)=$S(X]"":X,1:HLQ) ; name
- I VAFSTR[",3," S $P(VAFY,HLFS,3)=$S($P(NODE,"^",2)]"":$P(NODE,"^",2),1:HLQ) ; sex
- I VAFSTR[",4," S X=$$HLDATE^HLFNC($P(NODE,"^",3)),$P(VAFY,HLFS,4)=$S(X]"":X,1:HLQ) ; dob
- I VAFSTR[",5," S $P(VAFY,HLFS,5)=$S($P(NODE,"^",9)]"":$P(NODE,"^",9),1:HLQ) ; ssn
- I VAFSTR[",6," D
- .S NODE0=$G(^DGPR(408.12,+$G(VAFIEN),0))
- .S $P(VAFY,HLFS,6)=$S($P(NODE0,"^",2)]"":$P(NODE0,"^",2),1:HLQ) ; relationship to patient
- I VAFSTR[",7," S $P(VAFY,HLFS,7)=+$G(VAFIEN) ; internal entry number
- I VAFSTR[",8,",$$REL^DGMTU1(VAFIEN)="SPOUSE" D
- .S $P(VAFY,HLFS,8)=$S($P(NODE1,"^")]"":$P(NODE1,"^"),1:HLQ) ; spouse's maiden name
- I VAFSTR[",9," D
- .S X=-($E(VAFMTDT,1,3)-1_"1231.9"),X=-$O(^DGPR(408.12,+$G(VAFIEN),"E","AID",X))
- .S X=$$HLDATE^HLFNC(X),$P(VAFY,HLFS,9)=$S(X]"":X,1:HLQ) ; effective date
- I VAFSTR[",10," S $P(VAFY,HLFS,10)=$S($P(NODE,"^",10)]"":$P(NODE,"^",10),1:HLQ) ; pseudo ssn reason
- I VAFSTR[",11," S X=$$HLDATE^HLFNC($G(VAFIADT)),$P(VAFY,HLFS,11)=$S(X]"":X,1:HLQ) ; inactivation date
- I VAFSTR[",13," D ; Address
- .S X=$$HLADDR^HLFNC($P(NODE1,"^",2,3),$P(NODE1,"^",5,7))
- .I $P(X,CS)="" S $P(VAFY,HLFS,13)=HLQ Q ;Must have Addr Line 1
- .S $P(X,CS,6)="",$P(X,CS,7)="P",$P(X,CS,8)=$P(NODE1,"^",4)
- .S $P(X,CS,12)=$$HLDATE^HLFNC($P(NODE1,"^",9))
- .S $P(VAFY,HLFS,13)=X
- I VAFSTR[",14," D ; Telephone
- .S X=$$HLPHONE^HLFNC($P(NODE1,"^",8))
- .I X="" S $P(VAFY,HLFS,14)=HLQ Q
- .S $P(VAFY,HLFS,14)=X_CS_"PRN"_CS_"PH"
- ;
- QUIT Q "ZDP"_HLFS_$G(VAFY)
- ;
- NODE1(DGPRI) ;GET Node 1 of Patient Relation
- N DGVPI,DGVP1
- S DGVPI=$P($G(^DGPR(408.12,DGPRI,0)),"^",3)
- I DGVPI]"" S DGVP1=$G(@("^"_$P(DGVPI,";",2)_+DGVPI_",1)"))
- Q $S($G(DGVP1)]"":DGVP1,1:"")
- VAFHLZDP ;ALB/MLI,TDM - Creates HL7 segments ZDP and/or ZIC ; 1/21/09 3:49pm
- +1 ;;5.3;PIMS;**33,653,688,1015,1016**;JUN 30, 2012;Build 20
- +2 ;
- +3 ; This routine will return the ZDP (dependent) segment for the
- +4 ; dependent specified by the variable VAFIEN.
- +5 ;
- EN(VAFIEN,VAFSTR,VAFNUM,VAFMTDT,VAFIADT) ; Call to produce ZDP segment for given individual
- +1 ;
- +2 ;
- +3 ; Input: VAFIEN as IEN of PATIENT RELATION (#408.12) file
- +4 ; VAFSTR as string of desired fields separated by commas
- +5 ; VAFNUM as the number desired for the set id (default = 1)
- +6 ; VAFMTDT as the date of the means test (default = DT)
- +7 ; VAFIADT as spouse/dependent inactivation date (optional)
- +8 ;
- +9 ; Output: String of fields forming HL7 ZDP segment
- +10 ;
- +11 NEW NODE,NODE0,X,VAFY,NODE1,CS,SS,RS
- +12 SET CS=$EXTRACT(HLECH,1)
- SET SS=$EXTRACT(HLECH,4)
- SET RS=$EXTRACT(HLECH,2)
- +13 SET NODE=$$DEM^DGMTU1(+$GET(VAFIEN))
- SET NODE1=$$NODE1(+$GET(VAFIEN))
- +14 IF $GET(VAFSTR)']""
- GOTO QUIT
- +15 SET $PIECE(VAFY,HLFS,14)=""
- SET VAFSTR=","_VAFSTR_","
- +16 SET $PIECE(VAFY,HLFS,1)=$SELECT($GET(VAFNUM):VAFNUM,1:1)
- +17 SET VAFMTDT=$SELECT($GET(VAFMTDT):VAFMTDT,1:DT)
- +18 ; name
- IF VAFSTR[",2,"
- SET X=$$HLNAME^HLFNC($PIECE(NODE,"^",1))
- SET $PIECE(VAFY,HLFS,2)=$SELECT(X]"":X,1:HLQ)
- +19 ; sex
- IF VAFSTR[",3,"
- SET $PIECE(VAFY,HLFS,3)=$SELECT($PIECE(NODE,"^",2)]"":$PIECE(NODE,"^",2),1:HLQ)
- +20 ; dob
- IF VAFSTR[",4,"
- SET X=$$HLDATE^HLFNC($PIECE(NODE,"^",3))
- SET $PIECE(VAFY,HLFS,4)=$SELECT(X]"":X,1:HLQ)
- +21 ; ssn
- IF VAFSTR[",5,"
- SET $PIECE(VAFY,HLFS,5)=$SELECT($PIECE(NODE,"^",9)]"":$PIECE(NODE,"^",9),1:HLQ)
- +22 IF VAFSTR[",6,"
- Begin DoDot:1
- +23 SET NODE0=$GET(^DGPR(408.12,+$GET(VAFIEN),0))
- +24 ; relationship to patient
- SET $PIECE(VAFY,HLFS,6)=$SELECT($PIECE(NODE0,"^",2)]"":$PIECE(NODE0,"^",2),1:HLQ)
- End DoDot:1
- +25 ; internal entry number
- IF VAFSTR[",7,"
- SET $PIECE(VAFY,HLFS,7)=+$GET(VAFIEN)
- +26 IF VAFSTR[",8,"
- IF $$REL^DGMTU1(VAFIEN)="SPOUSE"
- Begin DoDot:1
- +27 ; spouse's maiden name
- SET $PIECE(VAFY,HLFS,8)=$SELECT($PIECE(NODE1,"^")]"":$PIECE(NODE1,"^"),1:HLQ)
- End DoDot:1
- +28 IF VAFSTR[",9,"
- Begin DoDot:1
- +29 SET X=-($EXTRACT(VAFMTDT,1,3)-1_"1231.9")
- SET X=-$ORDER(^DGPR(408.12,+$GET(VAFIEN),"E","AID",X))
- +30 ; effective date
- SET X=$$HLDATE^HLFNC(X)
- SET $PIECE(VAFY,HLFS,9)=$SELECT(X]"":X,1:HLQ)
- End DoDot:1
- +31 ; pseudo ssn reason
- IF VAFSTR[",10,"
- SET $PIECE(VAFY,HLFS,10)=$SELECT($PIECE(NODE,"^",10)]"":$PIECE(NODE,"^",10),1:HLQ)
- +32 ; inactivation date
- IF VAFSTR[",11,"
- SET X=$$HLDATE^HLFNC($GET(VAFIADT))
- SET $PIECE(VAFY,HLFS,11)=$SELECT(X]"":X,1:HLQ)
- +33 ; Address
- IF VAFSTR[",13,"
- Begin DoDot:1
- +34 SET X=$$HLADDR^HLFNC($PIECE(NODE1,"^",2,3),$PIECE(NODE1,"^",5,7))
- +35 ;Must have Addr Line 1
- IF $PIECE(X,CS)=""
- SET $PIECE(VAFY,HLFS,13)=HLQ
- QUIT
- +36 SET $PIECE(X,CS,6)=""
- SET $PIECE(X,CS,7)="P"
- SET $PIECE(X,CS,8)=$PIECE(NODE1,"^",4)
- +37 SET $PIECE(X,CS,12)=$$HLDATE^HLFNC($PIECE(NODE1,"^",9))
- +38 SET $PIECE(VAFY,HLFS,13)=X
- End DoDot:1
- +39 ; Telephone
- IF VAFSTR[",14,"
- Begin DoDot:1
- +40 SET X=$$HLPHONE^HLFNC($PIECE(NODE1,"^",8))
- +41 IF X=""
- SET $PIECE(VAFY,HLFS,14)=HLQ
- QUIT
- +42 SET $PIECE(VAFY,HLFS,14)=X_CS_"PRN"_CS_"PH"
- End DoDot:1
- +43 ;
- QUIT QUIT "ZDP"_HLFS_$GET(VAFY)
- +1 ;
- NODE1(DGPRI) ;GET Node 1 of Patient Relation
- +1 NEW DGVPI,DGVP1
- +2 SET DGVPI=$PIECE($GET(^DGPR(408.12,DGPRI,0)),"^",3)
- +3 IF DGVPI]""
- SET DGVP1=$GET(@("^"_$PIECE(DGVPI,";",2)_+DGVPI_",1)"))
- +4 QUIT $SELECT($GET(DGVP1)]"":DGVP1,1:"")
