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

DBTSADD.m

Go to the documentation of this file.
  1. DBTSADD ;BAO/DMH begin load of patient to sql call [ 10/29/1999 5:56 PM ]
  1. ;
  1. ;
  1. ; this program is called from the DBTS ADD PATIENT BEGIN remote proc.
  1. ; if it is not already in the
  1. ;
  1. ;
  1. START ;
  1. ;
  1. BEG(DBTSRET,DBTSP) ;dbtsret is return value, dbtsp input value of patient ien
  1. ;
  1. ;
  1. TEST ;
  1. K DBTSNEW
  1. S ARRAY=0
  1. ;S DBTSP=71 ;uncomment if want to test with call to TEST directly
  1. ;S DBTSP=17897 ;crow demo patient dfn for testing
  1. ;
  1. D ^XBKVAR
  1. I DUZ(2)=4526 S DUZ(2)=2348
  1. S DBTS("LOC")=$P($G(^AUTTLOC(DUZ(2),0)),"^",10)
  1. I DBTS("LOC")="" S DBTSRET(1)="-1" Q
  1. S DBTS("ID")=DBTS("LOC")_"|1419200BEG|"_DBTSP
  1. ;
  1. ;
  1. K DBTS("NEWPAT")
  1. I '$D(^DBTSPAT(DBTSP)) S DBTS("NEWPAT")="Y" D Q
  1. .K ^DBTSPAT("B",DBTSP)
  1. .S X=DBTSP,DINUM=X,DIC(0)="XNL",DIC="^DBTSPAT(" D FILE^DICN
  1. .S DBTSNEW="Y"
  1. .S DBTSRET(1)="1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^1^"
  1. .Q
  1. ;
  1. ; put the patient log information to a temporary holding
  1. I '$D(^DBTSPAT(DBTSP,"A")) S DBTSRET(1)="-1" Q
  1. S NODE=""
  1. F S NODE=$O(^DBTSPAT(DBTSP,NODE)) Q:NODE="" D
  1. .S ^DBTS("TMP",DBTSP,NODE)=^DBTSPAT(DBTSP,NODE)
  1. .Q
  1. S ^DBTS("TMP",DBTSP,"ZZSAVEDON")=DT
  1. SET ;
  1. S DBTSRET(1)=$P(^DBTSPAT(DBTSP,"A"),"^",2)
  1. S DBTSRET(1)=$TR(DBTSRET(1),"|","^")
  1. Q