Routine: VAUQWK

VAUQWK ;ALB/MLI - QUICK LOOKUP ON DPT VARIABLES ; 29 MAR 89@1500

 ;;5.3;Registration;;Aug 13, 1993

 F I=1:1:13 S VAQK(I)=""

 Q:'$D(DFN)  Q:'$D(^DPT(+DFN,0))

 F I=0,.1,.101,.321,.36,.52 S VA(I)=$S($D(^DPT(+DFN,I)):^(I),1:"")

 S VAQK(1)=$P(VA(0),"^",1),VAQK(2)=$P(VA(0),"^",9) S:VAQK(2)]"" VAQK(2)=VAQK(2)_"^"_$E(VAQK(2),1,3)_"-"_$E(VAQK(2),4,5)_"-"_$E(VAQK(2),6,9) S (VAQK(3),Y)=$P(VA(0),"^",3) I Y]"" X ^DD("DD") S VAQK(3)=VAQK(3)_"^"_Y

 S VA(1)=$S('$D(^DPT(DFN,.35)):"",'^(.35):"",1:+^(.35)),VA(2)=$S('VA(1):DT,1:VA(1)),VAQK(4)=$E(VA(2),1,3)-$E(VAQK(3),1,3)-($E(VA(2),4,7)<$E(VAQK(3),4,7)),VAQK(5)=$P(VA(0),"^",2)

 I VAQK(5)]"" S VAQK(5)=VAQK(5)_"^"_$S(VAQK(5)="M":"MALE",VAQK(5)="F":"FEMALE",1:"")

 S VAQK(6)=$P(VA(.36),"^",1) I VAQK(6)]"" S VAQK(6)=VAQK(6)_"^"_$S($D(^DIC(8,+VAQK(6),0)):$P(^(0),"^",1),1:"")

 F I=7:1:10 S VA=$S(I<10:$P(VA(.321),"^",I-6),1:$P(VA(.52),"^",5)) S VAQK(I)=$S(VA="Y":1,1:0)

 S VA=$G(^DG(408.32,+$P(VA(0),"^",14),0)) I VA]"" S VAQK(11)=$P(VA,"^",2)_"^"_$P(VA,"^",1)

 F I=12:1:13 S VAQK(I)=$P(VA($S(I=12:.1,1:.101)),"^",1)

 K I,VA,Y Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAUQWK   1077     printed  Mar 13, 2025@22:08:40                                                                                                                                                                                                      Page 2

VAUQWK    ;ALB/MLI - QUICK LOOKUP ON DPT VARIABLES ; 29 MAR 89@1500

 +1       ;;5.3;Registration;;Aug 13, 1993

 +2        FOR I=1:1:13

               SET VAQK(I)=""

 +3        if '$DATA(DFN)

               QUIT

           if '$DATA(^DPT(+DFN,0))

               QUIT

 +4        FOR I=0,.1,.101,.321,.36,.52

               SET VA(I)=$SELECT($DATA(^DPT(+DFN,I)):^(I),1:"")

 +5        SET VAQK(1)=$PIECE(VA(0),"^",1)

           SET VAQK(2)=$PIECE(VA(0),"^",9)

           if VAQK(2)]""

               SET VAQK(2)=VAQK(2)_"^"_$EXTRACT(VAQK(2),1,3)_"-"_$EXTRACT(VAQK(2),4,5)_"-"_$EXTRACT(VAQK(2),6,9)

           SET (VAQK(3),Y)=$PIECE(VA(0),"^",3)

           IF Y]""

               XECUTE ^DD("DD")

               SET VAQK(3)=VAQK(3)_"^"_Y

 +6        SET VA(1)=$SELECT('$DATA(^DPT(DFN,.35)):"",'^(.35):"",1:+^(.35))

           SET VA(2)=$SELECT('VA(1):DT,1:VA(1))

           SET VAQK(4)=$EXTRACT(VA(2),1,3)-$EXTRACT(VAQK(3),1,3)-($EXTRACT(VA(2),4,7)<$EXTRACT(VAQK(3),4,7))

           SET VAQK(5)=$PIECE(VA(0),"^",2)

 +7        IF VAQK(5)]""

               SET VAQK(5)=VAQK(5)_"^"_$SELECT(VAQK(5)="M":"MALE",VAQK(5)="F":"FEMALE",1:"")

 +8        SET VAQK(6)=$PIECE(VA(.36),"^",1)

           IF VAQK(6)]""

               SET VAQK(6)=VAQK(6)_"^"_$SELECT($DATA(^DIC(8,+VAQK(6),0)):$PIECE(^(0),"^",1),1:"")

 +9        FOR I=7:1:10

               SET VA=$SELECT(I<10:$PIECE(VA(.321),"^",I-6),1:$PIECE(VA(.52),"^",5))

               SET VAQK(I)=$SELECT(VA="Y":1,1:0)

 +10       SET VA=$GET(^DG(408.32,+$PIECE(VA(0),"^",14),0))

           IF VA]""

               SET VAQK(11)=$PIECE(VA,"^",2)_"^"_$PIECE(VA,"^",1)

 +11       FOR I=12:1:13

               SET VAQK(I)=$PIECE(VA($SELECT(I=12:.1,1:.101)),"^",1)

 +12       KILL I,VA,Y

           QUIT

VAUQWK.m