Routine: DBTSPATT

DBTSPATT ;BAO/DMH  gui patient lookup for dm register [ 07/16/1998  11:39 AM ]

 ;7/16/98

ST ;

PAT(DBTSRET,DBTSP)  ;EP Patient Lookup

TEST ;

 K ^DBTSTMP

 S DBTSP="GL"

 I DBTSP="" S DBTSRET="-1" Q

 F I=1:1:3 S DBTSPAT(I)=$P(DBTSP,"^",I)

 F I=3:-1:1 I DBTSPAT(I)'="" S DBTSVAL=DBTSPAT(I) Q

 S DBTSC=100

 D ^XBKVAR

 I DUZ(2)=4526 S DUZ(2)=2348

 S DBTFIL=9000001

 S DBTIENS=""

 S DBTFIELDS=".01"

 S DBTFLAGS="M"

 S DBTVALUE=DBTSP

 S DBTNUMBER=DBTSC

 S DBTINDEXES=""

 S DBTSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")

 S DBTIDEN=""

 ;S DBTTARG="DBTS"

 S DBTTARG="^DBTSTMP"

 S DBTMSG=""

 ;D FIND^DIC(DBTFILE,DBTIENS,DBTFIELDS,DBTFLAGS,DBTVALUE,DBTNUMBER,DBTINDEXES,DBTSCREEN,DBTIDEN,DBTTARG,DBTMSG)

 D FIND^DIC(9000001,"",".01","M",DBTSVAL,100,"",DBTSCREEN,DBTIDEN,DBTTARG,DBTMSG)

 S DBTSRET=""

 Q:'+$G(^DBTSTMP("DILIST",0))

 F DBTSCT=1:1:$P(^DBTSTMP("DILIST",0),U) D

 . S DBTSIEN=^DBTSTMP("DILIST",2,DBTSCT)

 . S DBTSREC=^DBTSTMP("DILIST","ID",DBTSCT,.01)                  ;NAME

 . S DBTSDPT=$G(^DPT(DBTSIEN,0))

 . S DBTSSSN=$P(DBTSDPT,U,9)

 . I DBTSSSN?9N S DBTSSSN=$E(DBTSSSN,1,3)_"-"_$E(DBTSSSN,4,5)_"-"_$E(DBTSSSN,6,9)

 . S $P(DBTSREC,"^",2)=DBTSSSN                                   ;SSN

 . S $P(DBTSREC,"^",3)=$P($G(^AUPNPAT(DBTSIEN,41,DUZ(2),0)),U,2) ;CHART

 . S Y=$P(DBTSDPT,U,3) D DOB ;X ^DD("DD")

 . S $P(DBTSREC,"^",4)=DOB                                         ;DOB

 . S $P(DBTSREC,"^",5)=DBTSIEN

 . S DBTSRET(DBTSCT)=DBTSREC

. Q

 ;K DBTS

 S DBTSRET(DBTSCT+1)="**END**"

 S DBTSRET(0.000001)=DBTSCT

DOB ;

 S DOB=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))

DBTSPATT.m