- YSDGDEM ;ALB/ASF,ALB/XAK,ALB/MJK-Patient Demographic Lookup ;3/28/90 14:09 ;07/28/93 15:36
- ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
- P ;
- W ! S DIC="^DPT(",DIC(0)="QEAM" D ^DIC Q:Y<0 S YSDFN=+Y D EN G P
- EN ; Called by routine YSPPJ
- S DFN=YSDFN D DEM^VADPT,PID^VADPT
- S PTI(0)=^DPT(YSDFN,0),PTI(.11)=$G(^(.11)),PTI(.13)=$G(^(.13)),I=+$P(PTI(0),U,3),PTI(.362)=$G(^(.362)),PTI(.361)=$P($G(^(.361)),U),YSSSN=VA("PID")
- I $D(^DPT(YSDFN,.121)) S X=$S($P(^(.121),U,8):$P(^(.121),U,8),1:9999999) I DT'<$P(^(.121),U,7),DT'>X S PTI(.11)=^(.121),YSADFL=""
- I '$D(IOF) S IOP=IO D ^%ZIS K IOP
- W @IOF,!,VADM(1),?32,"SSN: ",YSSSN,?58,"DOB: ",$P(VADM(3),U,2)
- W !,$P(PTI(.11),U),?32,"C-#: ",$S($D(^DPT(YSDFN,.31)):$P(^(.31),U,3),1:"Unknown"),?53,"Religion: ",$E($E($G(^DIC(13,+$P(PTI(0),U,8),0)),U),1,17)
- W !,$P(PTI(.11),U,4),?42,"Elig: " I $D(^DPT(YSDFN,.36)),$D(^DIC(8,+^(.36),0)) W $P(^(0),U)
- W !,$P($G(^DIC(5,+$P(PTI(.11),U,5),0)),U)
- W " ",$$ZIP4^YSPP(+YSDFN,1),?42,"HB:",$P(PTI(.362),U,2),?55,"A&A:",$P(PTI(.362),U)
- W !,"PHONE: ",$P(PTI(.13),U),?42,"***ELIGIBILITY ",$S(PTI(.361)="P":"PENDING VERIFICATION",PTI(.361)="R":"PENDING RE-VERIFICATION",PTI(.361)="V":"VERIFIED",1:"NOT VERIFIED"),"***"
- I $D(YSADFL) S YSEND=$P(PTI(.11),U,8) W !,"(Temporary Address - ",$S('YSEND:"no end date",1:"until "_$$FMTE^XLFDT(YSEND,"5ZD")),")" K YSADFL,YSEND
- G ^YSDGDEM0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDGDEM 1373 printed Jan 18, 2025@03:15:16 Page 2
- YSDGDEM ;ALB/ASF,ALB/XAK,ALB/MJK-Patient Demographic Lookup ;3/28/90 14:09 ;07/28/93 15:36
- +1 ;;5.01;MENTAL HEALTH;**37**;Dec 30, 1994
- P ;
- +1 WRITE !
- SET DIC="^DPT("
- SET DIC(0)="QEAM"
- DO ^DIC
- if Y<0
- QUIT
- SET YSDFN=+Y
- DO EN
- GOTO P
- EN ; Called by routine YSPPJ
- +1 SET DFN=YSDFN
- DO DEM^VADPT
- DO PID^VADPT
- +2 SET PTI(0)=^DPT(YSDFN,0)
- SET PTI(.11)=$GET(^(.11))
- SET PTI(.13)=$GET(^(.13))
- SET I=+$PIECE(PTI(0),U,3)
- SET PTI(.362)=$GET(^(.362))
- SET PTI(.361)=$PIECE($GET(^(.361)),U)
- SET YSSSN=VA("PID")
- +3 IF $DATA(^DPT(YSDFN,.121))
- SET X=$SELECT($PIECE(^(.121),U,8):$PIECE(^(.121),U,8),1:9999999)
- IF DT'<$PIECE(^(.121),U,7)
- IF DT'>X
- SET PTI(.11)=^(.121)
- SET YSADFL=""
- +4 IF '$DATA(IOF)
- SET IOP=IO
- DO ^%ZIS
- KILL IOP
- +5 WRITE @IOF,!,VADM(1),?32,"SSN: ",YSSSN,?58,"DOB: ",$PIECE(VADM(3),U,2)
- +6 WRITE !,$PIECE(PTI(.11),U),?32,"C-#: ",$SELECT($DATA(^DPT(YSDFN,.31)):$PIECE(^(.31),U,3),1:"Unknown"),?53,"Religion: ",$EXTRACT($EXTRACT($GET(^DIC(13,+$PIECE(PTI(0),U,8),0)),U),1,17)
- +7 WRITE !,$PIECE(PTI(.11),U,4),?42,"Elig: "
- IF $DATA(^DPT(YSDFN,.36))
- IF $DATA(^DIC(8,+^(.36),0))
- WRITE $PIECE(^(0),U)
- +8 WRITE !,$PIECE($GET(^DIC(5,+$PIECE(PTI(.11),U,5),0)),U)
- +9 WRITE " ",$$ZIP4^YSPP(+YSDFN,1),?42,"HB:",$PIECE(PTI(.362),U,2),?55,"A&A:",$PIECE(PTI(.362),U)
- +10 WRITE !,"PHONE: ",$PIECE(PTI(.13),U),?42,"***ELIGIBILITY ",$SELECT(PTI(.361)="P":"PENDING VERIFICATION",PTI(.361)="R":"PENDING RE-VERIFICATION",PTI(.361)="V":"VERIFIED",1:"NOT VERIFIED"),"***"
- +11 IF $DATA(YSADFL)
- SET YSEND=$PIECE(PTI(.11),U,8)
- WRITE !,"(Temporary Address - ",$SELECT('YSEND:"no end date",1:"until "_$$FMTE^XLFDT(YSEND,"5ZD")),")"
- KILL YSADFL,YSEND
- +12 GOTO ^YSDGDEM0