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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPATV 1023 printed Oct 16, 2024@18:47:51 Page 2
DGPATV ;ALB/MRL-PATIENT VARIABLES ;22 MAY 87
+1 ;;5.3;Registration;**149**;Aug 13, 1993
+2 if '$DATA(DFN)
QUIT
SET DGNODE=$SELECT($DATA(^DPT(DFN,0)):^(0),1:"")
SET DGNAME=$SELECT($PIECE(DGNODE,"^",1)]"":$PIECE(DGNODE,"^",1),1:"UNSPECIFIED #"_DFN)
SET DOB=$SELECT($PIECE(DGNODE,"^",3)?7N:$PIECE(DGNODE,"^",3),1:"DOB UNSPECIFIED")
+3 IF DOB]""
SET Y=DOB
XECUTE ^DD("DD")
SET DOB=DOB_"^"_Y
+4 SET SSN=$SELECT($PIECE(DGNODE,"^",9)]"":$PIECE(DGNODE,"^",9),1:"UNSPECIFIED")
IF $EXTRACT(SSN,1,9)?9N
SET SSN=SSN_"^"_$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,10)
+5 SET DGEC="0^UNSPECIFIED"
SET DGVETS=$SELECT($DATA(^DPT(DFN,.36)):+$PIECE(^(.36),"^",1),1:0)
IF $DATA(^DIC(8,+DGVETS,0))
SET DGEC=+DGVETS_"^"_$PIECE(^(0),"^",1)
SET DGVETS=$PIECE(^(0),"^",5)
+6 if "^Y^N^"'[("^"_DGVETS_"^")
SET DGVETS=$SELECT('$DATA(^DPT(DFN,"VET")):"",1:^("VET"))
SET DGVETS=$SELECT(DGVETS="Y":1,1:0)
+7 SET DGCMOR="UNSPECIFIED"
SET DGMPI=$GET(^DPT(+DFN,"MPI"))
+8 SET DGLOCATN=$$FIND1^DIC(4,"","MX","`"_+$PIECE(DGMPI,U,3))
SET DGLOCATN=$SELECT(+DGLOCATN>0:$PIECE($$NS^XUAF4(DGLOCATN),U),1:"NOT LISTED")
+9 IF $DATA(DGMPI)
IF $DATA(DGLOCATN)
SET DGCMOR=$PIECE(DGLOCATN,"^")
+10 QUIT
KILL KILL DGCMOR,DGMPI,DGLOCATN,DGNODE,DGNAME,SSN,DOB,DGVETS,DGEC
QUIT
