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

DBTSPROV.m

Go to the documentation of this file.
  1. DBTSPROV ;DMH\BAO routine used to AUDIT PROVIDER table to send to Diabetes Tracker Database!!! [ 10/04/1999 10:40 AM ]
  1. ; dmh -- 9/27/1999
  1. ;
  1. ;
  1. PROV(DBTSRET,DBTSINPT) ;
  1. ;
  1. ST ;
  1. D ^XBKVAR
  1. ;
  1. I $D(DBTSINPT) I DBTSINPT="BEGIN" S $P(^DBTSPARM(DUZ(2),0),"^",4)=0 S DBTSRET(1)="OK" Q
  1. ;
  1. S DBTS=+$P($G(^DBTSPARM(DUZ(2),0)),"^",4)
  1. TEST ;
  1. ;S DBTS=900
  1. I '$D(DBTS) S DBTSRET(1)=-1 Q
  1. S LOC=$P($G(^AUTTLOC(DUZ(2),0)),"^",10)
  1. I LOC="" S DBTSRET(1)="-1" Q
  1. S CT=0
  1. F S DBTS=$O(^DIA(200,DBTS)) Q:+DBTS=0 D
  1. .S $P(^DBTSPARM(DUZ(2),0),"^",4)=DBTS
  1. . ;
  1. . ; above line logs the last DIA entry that was sent to SQL
  1. . ;
  1. .I '$D(^DIA(200,DBTS,0)) Q
  1. .S DBTSNO=$P(^DIA(200,DBTS,0),"^",1)
  1. .S DBTSREC=^VA(200,DBTSNO,0)
  1. .S NAME=$P(DBTSREC,U,1)
  1. .S SSN=$P($G(^VA(200,DBTSNO,1)),"^",9)
  1. .Q:SSN=""
  1. .Q:'$D(^VA(200,DBTSNO,9999999))
  1. .Q:'$D(^VA(200,DBTSNO,"PS"))
  1. .S AFF=$P($G(^VA(200,DBTSNO,9999999)),"^",1)
  1. .Q:AFF=""
  1. .S PSREC=$G(^VA(200,DBTSNO,"PS"))
  1. .S ID=$P(PSREC,"^",4)
  1. .I ID'="" S ID=$E(ID,4,5)_"/"_$E(ID,6,7)_"/"_(1700+$E(ID,1,3))
  1. .S DISC=$P(PSREC,"^",5)
  1. .Q:DISC=""
  1. .S DISC=$P(^DIC(7,DISC,9999999),"^",1)
  1. .S CT=CT+1
  1. .S DBTSRET(CT)=DBTSNO_U_LOC_U_NAME_U_DISC_U_AFF_U_ID
  1. .Q
  1. I '$D(DBTSRET) S DBTSRET(1)=-2
  1. END ;
  1. K CT,DBTSREC,DBTSNO,DBTS,NAME,LOC,ID,DISC,AFF
  1. Q