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

DBTSLAB.m

Go to the documentation of this file.
  1. DBTSLAB ;BAO/DMH pull patient LAB [ 12/09/1998 1:45 PM ]
  1. ;
  1. ;
  1. ;
  1. START ;
  1. ;
  1. LAB(DBTSRET,DBTSP) ;dbtsret is return value, dbtsp input value of patient ien
  1. ;
  1. ;
  1. TEST ;
  1. S ARRAY=0
  1. ;S DBTSP=13052 ;uncomment if want to test with call to TEST directly
  1. ;
  1. D ^XBKVAR
  1. I DUZ(2)=4526 S DUZ(2)=2348
  1. S DBTS("LOC")=$P(^AUTTLOC(DUZ(2),0),"^",10)
  1. S DBTS("FN")="9000010.09"
  1. S DBTS("IEN")=0
  1. ;
  1. ;
  1. I '$D(^DBTSLAB(DUZ(2))) S DBTSRET(1)="-1" Q
  1. I '$D(^DBTSLABI) S DBTSRET(1)="-1" Q
  1. ;
  1. F I=1:1 S DBTS("IEN")=$O(^AUPNVLAB("AC",DBTSP,DBTS("IEN"))) Q:+DBTS("IEN")=0 D
  1. .S REC=$G(^AUPNVLAB(DBTS("IEN"),0))
  1. .Q:REC=""
  1. .S DBTS("LAB")=$P(REC,U,1)
  1. .I DBTS("LAB")="" Q
  1. .S DBTS("RESULTS")=$P(REC,U,4)
  1. .Q:DBTS("RESULTS")=""
  1. .;S DBTS("LABTESTP")=$P(DBTS("LAB"),U,1)
  1. .D LABCK
  1. .Q:'$D(DBTS("LABID"))
  1. .S DBTS("V")=$P(REC,U,3)
  1. .S DBTS("VDATE")=$P($G(^AUPNVSIT(DBTS("V"),0)),U,1)
  1. .Q:DBTS("VDATE")=""
  1. .S DBTS("VDATE")=$P(DBTS("VDATE"),".",1)
  1. .S DBTS("VDATE")=$E(DBTS("VDATE"),4,5)_"/"_$E(DBTS("VDATE"),6,7)_"/"_($E(DBTS("VDATE"),1,3)+1700)
  1. .S DBTS("RESULTS")=$P(REC,U,4)
  1. .;
  1. .;
  1. .;
  1. .S DBTS("PAT")=DBTSP
  1. .S DBTS("CN")=$P(^AUPNPAT(DBTSP,41,DUZ(2),0),"^",2)
  1. .S ARRAY=ARRAY+1
  1. .S DBTS("ID")=DBTS("LOC")_"|"_DBTS("FN")_"|"_DBTS("IEN")
  1. .S DBTSRET(ARRAY)=DBTS("ID")_U_DBTS("LOC")_U_"A"_U_DBTS("PAT")_U_"LAB"_U_DBTS("LABID")_U_DBTS("VDATE")_U_DBTS("RESULTS")
  1. .Q
  1. I ARRAY=0 S DBTSRET(1)="-2"
  1. Q
  1. LABCK ;
  1. K DBTS("LABID")
  1. I '$D(^DBTSLAB(DUZ(2),11,"B",DBTS("LAB"))) Q
  1. S DBTS("N")=$O(^DBTSLAB(DUZ(2),11,"B",DBTS("LAB"),0))
  1. Q:DBTS("N")=""
  1. S DBTS("IDP")=$P(^DBTSLAB(DUZ(2),11,DBTS("N"),0),"^",2)
  1. S DBTS("LABID")=$P(^DBTSLABI(DBTS("IDP"),0),"^",1)
  1. Q