Routine: DGPATV

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,"^")

KILL K DGCMOR,DGMPI,DGLOCATN,DGNODE,DGNAME,SSN,DOB,DGVETS,DGEC Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPATV   1023     printed  Feb 19, 2025@00:13:16                                                                                                                                                                                                      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

DGPATV.m