Routine: DBTSPAT

DBTSPAT ;BAO/DMH  gui patient lookup for dm register [ 02/09/1999  11:50 AM ]

 ;7/16/98

ST ;

PAT(DBTSRET,DBTSP)  ;EP Patient Lookup

TEST ;

 ;S DBTSP="A"

 S ^DBTSPAT("TEST")=DBTSP

 I DBTSP="" S DBTSRET(0)="-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) I DBTSVAL?3N1"-"2N1"-"4N S DBTSVAL=$TR(DBTSVAL,"-","") Q

 S DBTSC=100

 D ^XBKVAR

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

 ;S DBTSRET="^DBTSTMP("_$J_")"

 S DBTSLOC=$P($G(^AUTTLOC(DUZ(2),0)),"^",10)

 I DBTSLOC="" S DBTSRET(1)="-1" Q

 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="^DBTTMP"

 S DBTMSG=""

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

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

 K DBTSRET

 K ^DBTSTMP($J)

 ;I '+$G(DBTS("DILIST",0)) S DBTSRET(0)="-1" Q

 I '+$G(^DBTTMP("DILIST",0)) S DBTSRET(0)="-1" Q

 ;F DBTSCT=1:1:$P(DBTS("DILIST",0),U) D  I DBTSCT>250 S ^DBTSTMP($J,855)="*** TOO MANY ROWS ***" Q

 ;F DBTSCT=1:1:$P(^DBTTMP("DILIST",0),U) D  I DBTSCT=250 S ^DBTSTMP($J,251)="*** TOO MANY ROWS ***" Q

 F DBTSCT=1:1:$P(^DBTTMP("DILIST",0),U) D  I DBTSCT=250 S DBTSRET(251)="*** TOO MANY ROWS ***" Q

 . ;S DBTSIEN=DBTS("DILIST",2,DBTSCT)

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

 . S DBTSREC=""

 . ;S $P(DBTSREC,"^",3)=DBTS("DILIST","ID",DBTSCT,.01)             ;NAME

 . S $P(DBTSREC,"^",3)=^DBTTMP("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,"^",4)=DBTSSSN                                   ;SSN

 . S $P(DBTSREC,"^",5)=$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,"^",6)=DOB                                         ;DOB

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

 . S $P(DBTSREC,"^",2)=DBTSLOC

 . S DBTSRET(DBTSCT)=DBTSREC

 . ;S ^DBTSTMP($J,DBTSCT)=DBTSREC

. Q

 ;K DBTS

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

 ;S DBTSRET(0.000001)=DBTSCT

 ;  took count and end records off--keith doesn't need these 7/16/98

DOB ;

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

DBTSPAT.m