Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPATV

DGPATV.m

Go to the documentation of this file.
DGPATV ;ALB/MRL-PATIENT VARIABLES ;22 MAY 87
 ;;5.3;Registration;**149**;Aug 13, 1993
 Q:'$D(DFN)  S DGNODE=$S($D(^DPT(DFN,0)):^(0),1:""),DGNAME=$S($P(DGNODE,"^",1)]"":$P(DGNODE,"^",1),1:"UNSPECIFIED #"_DFN),DOB=$S($P(DGNODE,"^",3)?7N:$P(DGNODE,"^",3),1:"DOB UNSPECIFIED")
 I DOB]"" S Y=DOB X ^DD("DD") S DOB=DOB_"^"_Y
 S SSN=$S($P(DGNODE,"^",9)]"":$P(DGNODE,"^",9),1:"UNSPECIFIED") I $E(SSN,1,9)?9N S SSN=SSN_"^"_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10)
 S DGEC="0^UNSPECIFIED",DGVETS=$S($D(^DPT(DFN,.36)):+$P(^(.36),"^",1),1:0) I $D(^DIC(8,+DGVETS,0)) S DGEC=+DGVETS_"^"_$P(^(0),"^",1),DGVETS=$P(^(0),"^",5)
 S:"^Y^N^"'[("^"_DGVETS_"^") DGVETS=$S('$D(^DPT(DFN,"VET")):"",1:^("VET")) S DGVETS=$S(DGVETS="Y":1,1:0)
 S DGCMOR="UNSPECIFIED",DGMPI=$G(^DPT(+DFN,"MPI"))
 S DGLOCATN=$$FIND1^DIC(4,"","MX","`"_+$P(DGMPI,U,3)),DGLOCATN=$S(+DGLOCATN>0:$P($$NS^XUAF4(DGLOCATN),U),1:"NOT LISTED")
 I $D(DGMPI),$D(DGLOCATN) S DGCMOR=$P(DGLOCATN,"^")
 Q
KILL K DGCMOR,DGMPI,DGLOCATN,DGNODE,DGNAME,SSN,DOB,DGVETS,DGEC Q