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

DENTUPD.m

Go to the documentation of this file.
  1. DENTUPD ; HISC/NCA - Update the Cross Reference ;4/15/96 09:27
  1. ;;1.2;DENTAL;**20,26**;Jan 26, 1996
  1. Q:'$D(^DENT(221,DENTK1,0))
  1. Q:$G(^DENT(221,DENTK1,.1))'=""
  1. N DENTDTE,DENTF,DENTI,DENTK,DENTDI,DENTO,DENTPA,DENTPR,DENTSK,DENTSSN
  1. S DENTK=$G(^DENT(221,DENTK1,0))
  1. S DENTDTE=$P(DENTK,"^",1),DENTSSN=$P(DENTK,"^",2),DENTPR=$P(DENTK,"^",10),DENTPA=$P(DENTK,"^",4),DENTDI=$P(DENTK,"^",40)
  1. S (DENTO,DENTSK)=9999999-DENTK1
  1. Q:DENTSK=$P(DENTK,"^",1)
  1. S DENTSK=$P(DENTK,"^",1)
  1. S DENTF="",DENTF=$O(^DENT(221,"B",DENTSK,DENTF))
  1. I DENTF="" G RESET
  1. F D Q:DENTF="" ; Do it until empty
  1. .S DENTF="",DENTSK=DENTSK+.000001 ; Add a second if date/time exist
  1. .I $E(DENTSK,13,14)>59 S DENTSK=DENTSK+.000040
  1. .I $E(DENTSK,11,12)>59 S DENTSK=DENTSK+.004000
  1. .I $E(DENTSK,9,10)>23 S X1=DENTSK,X2=1 D C^%DTC S DENTSK=X
  1. .S DENTF=$O(^DENT(221,"B",DENTSK,DENTF)) Q
  1. S $P(DENTK,"^",1)=DENTSK
  1. S DENTI=9999999-DENTSK K X,X1,X2
  1. RESET ; Reset Node and Update the X'Ref
  1. S ^DENT(221,DENTI,0)=DENTK K ^DENT(221,DENTK1,0)
  1. K:$D(^DENT(221,"A",DENTDI,(DENTO\1),DENTK1)) ^DENT(221,"A",DENTDI,(DENTO\1),DENTK1) S ^DENT(221,"A",DENTDI,(DENTSK\1),DENTI)=""
  1. I $D(^DENT(221,"A1",DENTDI,(DENTO\1),DENTK1)) K ^DENT(221,"A1",DENTDI,(DENTO\1),DENTK1) S ^DENT(221,"A1",DENTDI,(DENTSK\1),DENTI)=""
  1. K:$D(^DENT(221,"AC",DENTDI,(DENTO\1),DENTPR,DENTK1)) ^DENT(221,"AC",DENTDI,(DENTO\1),DENTPR,DENTK1) S ^DENT(221,"AC",DENTDI,(DENTSK\1),DENTPR,DENTI)=""
  1. I $D(^DENT(221,"AC1",DENTDI,(DENTO\1),DENTPR,DENTK1)) K ^DENT(221,"AC1",DENTDI,(DENTO\1),DENTPR,DENTK1) S ^DENT(221,"AC1",DENTDI,(DENTSK\1),DENTPR,DENTI)=""
  1. I $D(^DENT(221,"B",DENTDTE,DENTK1)) K ^DENT(221,"B",DENTDTE,DENTK1) S ^DENT(221,"B",$P(DENTK,"^",1),DENTI)=""
  1. I $D(^DENT(221,"C",DENTPR,DENTK1)) K ^DENT(221,"C",DENTPR,DENTK1) S ^DENT(221,"C",DENTPR,DENTI)=""
  1. I $D(^DENT(221,"D",DENTSSN,DENTK1)) K ^DENT(221,"D",DENTSSN,DENTK1) S ^DENT(221,"D",DENTSSN,DENTI)=""
  1. I $D(^DENT(221,"E",DENTPA,DENTK1)) K ^DENT(221,"E",DENTPA,DENTK1) S ^DENT(221,"E",DENTPA,DENTI)=""
  1. Q