YSLRP ;ALB/ASF,HIOFO/FT - LOOKUP PATIENT ;9/12/11 15:29
 ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
 ;
 ;Reference to ^DPT( supported by DBIA #10035
 ;
 ;Lookup patient
 ;Called by routines YSDX3, YSDX3R, YSDX3R1, YSGAF, YSGAF1, YSGAF2, YSHX1, YSMV, YSSR, YSSR1
 ; YTCHECK, YTEXT, YTKIL, YTMBMD, YTMCMI3, YTMMPI2A, YTONLY, YTQAPI14, YTQAPI15
 N DIC S DIC(0)="ACEQMZ",DIC="^DPT(",YSDFN=-1
 D ^DIC S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) S:Y>0 YSDFN=+Y,Z1=Y
 I $D(Y(0)) S:'$D(YSDFN(0)) YSDFN(0)=Y(0)
 I YSTOUT!YSUOUT!(YSDFN'>0) S YSQT=1 Q
PTVAR ;Patient Variables
 S DFN=YSDFN D DEM^VADPT,PID^VADPT
 S YSNM=VADM(1),YSSEX=$P(VADM(5),U),YSDOB=$P(VADM(3),U,2),YSAGE=VADM(4),YSSSN=VA("PID")
END ;
 Q
 ;
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSLRP   718     printed  Sep 23, 2025@19:50:46                                                                                                                                                                                                        Page 2
YSLRP     ;ALB/ASF,HIOFO/FT - LOOKUP PATIENT ;9/12/11 15:29
 +1       ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
 +2       ;
 +3       ;Reference to ^DPT( supported by DBIA #10035
 +4       ;
 +5       ;Lookup patient
 +6       ;Called by routines YSDX3, YSDX3R, YSDX3R1, YSGAF, YSGAF1, YSGAF2, YSHX1, YSMV, YSSR, YSSR1
 +7       ; YTCHECK, YTEXT, YTKIL, YTMBMD, YTMCMI3, YTMMPI2A, YTONLY, YTQAPI14, YTQAPI15
 +8        NEW DIC
           SET DIC(0)="ACEQMZ"
           SET DIC="^DPT("
           SET YSDFN=-1
 +9        DO ^DIC
           SET YSTOUT=$DATA(DTOUT)
           SET YSUOUT=$DATA(DUOUT)
           if Y>0
               SET YSDFN=+Y
               SET Z1=Y
 +10       IF $DATA(Y(0))
               if '$DATA(YSDFN(0))
                   SET YSDFN(0)=Y(0)
 +11       IF YSTOUT!YSUOUT!(YSDFN'>0)
               SET YSQT=1
               QUIT 
PTVAR     ;Patient Variables
 +1        SET DFN=YSDFN
           DO DEM^VADPT
           DO PID^VADPT
 +2        SET YSNM=VADM(1)
           SET YSSEX=$PIECE(VADM(5),U)
           SET YSDOB=$PIECE(VADM(3),U,2)
           SET YSAGE=VADM(4)
           SET YSSSN=VA("PID")
END       ;
 +1        QUIT 
 +2       ;