Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DBTSPATT

DBTSPATT.m

Go to the documentation of this file.
  1. DBTSPATT ;BAO/DMH gui patient lookup for dm register [ 07/16/1998 11:39 AM ]
  1. ;7/16/98
  1. ST ;
  1. PAT(DBTSRET,DBTSP) ;EP Patient Lookup
  1. ;
  1. TEST ;
  1. K ^DBTSTMP
  1. S DBTSP="GL"
  1. ;
  1. I DBTSP="" S DBTSRET="-1" Q
  1. F I=1:1:3 S DBTSPAT(I)=$P(DBTSP,"^",I)
  1. F I=3:-1:1 I DBTSPAT(I)'="" S DBTSVAL=DBTSPAT(I) Q
  1. S DBTSC=100
  1. D ^XBKVAR
  1. I DUZ(2)=4526 S DUZ(2)=2348
  1. ;
  1. S DBTFIL=9000001
  1. S DBTIENS=""
  1. S DBTFIELDS=".01"
  1. S DBTFLAGS="M"
  1. S DBTVALUE=DBTSP
  1. S DBTNUMBER=DBTSC
  1. S DBTINDEXES=""
  1. S DBTSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
  1. S DBTIDEN=""
  1. ;S DBTTARG="DBTS"
  1. S DBTTARG="^DBTSTMP"
  1. S DBTMSG=""
  1. ;
  1. ;D FIND^DIC(DBTFILE,DBTIENS,DBTFIELDS,DBTFLAGS,DBTVALUE,DBTNUMBER,DBTINDEXES,DBTSCREEN,DBTIDEN,DBTTARG,DBTMSG)
  1. ;
  1. ;
  1. D FIND^DIC(9000001,"",".01","M",DBTSVAL,100,"",DBTSCREEN,DBTIDEN,DBTTARG,DBTMSG)
  1. ;
  1. ;
  1. S DBTSRET=""
  1. Q:'+$G(^DBTSTMP("DILIST",0))
  1. F DBTSCT=1:1:$P(^DBTSTMP("DILIST",0),U) D
  1. . S DBTSIEN=^DBTSTMP("DILIST",2,DBTSCT)
  1. . S DBTSREC=^DBTSTMP("DILIST","ID",DBTSCT,.01) ;NAME
  1. . S DBTSDPT=$G(^DPT(DBTSIEN,0))
  1. . S DBTSSSN=$P(DBTSDPT,U,9)
  1. . I DBTSSSN?9N S DBTSSSN=$E(DBTSSSN,1,3)_"-"_$E(DBTSSSN,4,5)_"-"_$E(DBTSSSN,6,9)
  1. . S $P(DBTSREC,"^",2)=DBTSSSN ;SSN
  1. . S $P(DBTSREC,"^",3)=$P($G(^AUPNPAT(DBTSIEN,41,DUZ(2),0)),U,2) ;CHART
  1. . S Y=$P(DBTSDPT,U,3) D DOB ;X ^DD("DD")
  1. . S $P(DBTSREC,"^",4)=DOB ;DOB
  1. . S $P(DBTSREC,"^",5)=DBTSIEN
  1. . S DBTSRET(DBTSCT)=DBTSREC
  1. . Q
  1. ;K DBTS
  1. S DBTSRET(DBTSCT+1)="**END**"
  1. S DBTSRET(0.000001)=DBTSCT
  1. Q
  1. ;
  1. DOB ;
  1. S DOB=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_(1700+$E(Y,1,3))
  1. Q
  1. Q