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

DBTSEXFO.m

Go to the documentation of this file.
  1. DBTSEXFO ;BAO/DMH pull patient DIABETES FOOT exams [ 11/16/1999 9:15 PM ]
  1. ;
  1. ;
  1. ;
  1. START ;
  1. ;
  1. EXAM(DBTSGBL,DBTSP) ;dbtsret is return value, dbtsp input value of patient ien
  1. ;
  1. ;
  1. TEST ;
  1. K ^DBTSTEMP(1)
  1. S DBTSGBL="^DBTSTEMP("_1_")"
  1. S ARRAY=0
  1. ;S DBTSP=6
  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" S ^DBTSTEMP(1,1)="-1"_$C(13)_$C(10) Q
  1. S DBTS("FN")="9000010.13"
  1. S DBTS("IEN")=0
  1. EX ;
  1. S DTCT=0 ;comment out when go with live data
  1. F I=1:1 S DBTS("IEN")=$O(^AUPNVXAM("AC",DBTSP,DBTS("IEN"))) Q:+DBTS("IEN")=0 D
  1. .S REC=$G(^AUPNVXAM(DBTS("IEN"),0))
  1. .Q:REC=""
  1. .S DBTS("EXAM")=$P(REC,U,1)
  1. .I DBTS("EXAM")="" Q
  1. .S DBTS("EXNAME")=$P($G(^AUTTEXAM(DBTS("EXAM"),0)),U,1)
  1. .S DBTS("CODE")=$P($G(^AUTTEXAM(DBTS("EXAM"),0)),U,2)
  1. .Q:DBTS("CODE")'="28"
  1. .S DBTS("VDFN")=$P(REC,U,3)
  1. .S DBTS("MODDT")=$P($G(^AUPNVSIT(DBTS("VDFN"),0)),U,13)
  1. .S DBTS("VDATE")=$P($G(^AUPNVSIT(DBTS("VDFN"),0)),U,1)
  1. .Q:DBTS("VDATE")=""
  1. .S DBTS("V")=$P(DBTS("VDATE"),".",1)
  1. .Q:DBTS("V")=""
  1. .S DBTS("DT")=DBTS("V")
  1. .D DTCHK^DBTSUT
  1. .Q:$D(DBTS("BADDT"))
  1. .S DBTS("VDATE")=$E(DBTS("V"),4,5)_"/"_$E(DBTS("V"),6,7)_"/"_($E(DBTS("V"),1,3)+1700)
  1. .;
  1. .;
  1. .;
  1. .S DBTS("PAT")=DBTSP
  1. .S DBTS("CN")=$P($G(^AUPNPAT(DBTSP,41,DUZ(2),0)),"^",2)
  1. .S DBTS("ID")=DBTS("LOC")_"|"_DBTS("FN")_"|"_DBTS("IEN")
  1. .S DBTS("VID")=DBTS("LOC")_"|9000010|"_DBTS("VDFN") ;dmh 11-10-99
  1. .D MODCK
  1. .Q:DBTS("OK")="N"
  1. .S ARRAY=ARRAY+1
  1. .S DBTSRET(ARRAY)=DBTS("ID")_U_DBTS("LOC")_U_DBTS("AU")_U_DBTS("PAT")_U_DBTS("EXNAME")_U_DBTS("CODE")_U_DBTS("VDATE")_U_DBTS("VID")
  1. .S ^DBTSTEMP(1,ARRAY)=DBTSRET(ARRAY)_$C(13)_$C(10)
  1. .D LOG
  1. .Q
  1. I ARRAY=0 S DBTSRET(1)="-2" S ^DBTSTEMP(1,1)="-2"_$C(13)_$C(10)
  1. I $D(^DBTSPAT(DBTSP,"FTE")) S $P(^DBTSPAT(DBTSP,"FTE"),"^",2)=DT
  1. Q
  1. MODCK ;
  1. S DBTS("OK")="Y"
  1. S DBTS("AU")="A"
  1. Q:'$D(^DBTSPAT(DBTSP,"FTE"))
  1. ;I $P(^DBTSPAT(DBTSP,"FTE"),"^",2)="" Q ;11-16-99
  1. S DBTS("MREC")=$G(^DBTSPAT(DBTSP,"FTE"))
  1. Q:DBTS("MREC")=""
  1. S DBTS("LDFN")=$P(DBTS("MREC"),U,1)
  1. I $P(^DBTSPAT(DBTSP,"FTE"),"^",2)="" Q ;11-16-99
  1. Q:+DBTS("LDFN")<DBTS("IEN")
  1. S DBTS("LDT")=$P(DBTS("MREC"),U,2)
  1. I (+DBTS("LDT")>DBTS("MODDT")),(DBTS("LDFN")>DBTS("IEN")) S DBTS("OK")="N" Q
  1. I (DBTS("LDT")'>DBTS("MODDT")) S DBTS("AU")="U" Q
  1. S DBTS("OK")="N" Q
  1. Q
  1. LOG ; update the patient log for the type of lab test
  1. I '$D(DT) D ^XBKVAR
  1. I '$D(^DBTSPAT(DBTSP)) D
  1. .K ^DBTSPAT("B",DBTSP)
  1. .S X=DBTSP,DINUM=X,DIC(0)="XNL",DIC="^DBTSPAT(" D FILE^DICN
  1. I '$D(^DBTSPAT(DBTSP,"FTE")) S ^DBTSPAT(DBTSP,"FTE")=DBTS("IEN")_"^" Q
  1. I $G(DBTS("LDFN"))<DBTS("IEN") S $P(^DBTSPAT(DBTSP,"FTE"),"^",1)=DBTS("IEN")
  1. Q