source: WorldVistAEHR/trunk/r/DENTAL-DEN/DENTUPD.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1DENTUPD ; HISC/NCA - Update the Cross Reference ;4/15/96 09:27
2 ;;1.2;DENTAL;**20,26**;Jan 26, 1996
3 Q:'$D(^DENT(221,DENTK1,0))
4 Q:$G(^DENT(221,DENTK1,.1))'=""
5 N DENTDTE,DENTF,DENTI,DENTK,DENTDI,DENTO,DENTPA,DENTPR,DENTSK,DENTSSN
6 S DENTK=$G(^DENT(221,DENTK1,0))
7 S DENTDTE=$P(DENTK,"^",1),DENTSSN=$P(DENTK,"^",2),DENTPR=$P(DENTK,"^",10),DENTPA=$P(DENTK,"^",4),DENTDI=$P(DENTK,"^",40)
8 S (DENTO,DENTSK)=9999999-DENTK1
9 Q:DENTSK=$P(DENTK,"^",1)
10 S DENTSK=$P(DENTK,"^",1)
11 S DENTF="",DENTF=$O(^DENT(221,"B",DENTSK,DENTF))
12 I DENTF="" G RESET
13 F D Q:DENTF="" ; Do it until empty
14 .S DENTF="",DENTSK=DENTSK+.000001 ; Add a second if date/time exist
15 .I $E(DENTSK,13,14)>59 S DENTSK=DENTSK+.000040
16 .I $E(DENTSK,11,12)>59 S DENTSK=DENTSK+.004000
17 .I $E(DENTSK,9,10)>23 S X1=DENTSK,X2=1 D C^%DTC S DENTSK=X
18 .S DENTF=$O(^DENT(221,"B",DENTSK,DENTF)) Q
19 S $P(DENTK,"^",1)=DENTSK
20 S DENTI=9999999-DENTSK K X,X1,X2
21RESET ; Reset Node and Update the X'Ref
22 S ^DENT(221,DENTI,0)=DENTK K ^DENT(221,DENTK1,0)
23 K:$D(^DENT(221,"A",DENTDI,(DENTO\1),DENTK1)) ^DENT(221,"A",DENTDI,(DENTO\1),DENTK1) S ^DENT(221,"A",DENTDI,(DENTSK\1),DENTI)=""
24 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)=""
25 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)=""
26 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)=""
27 I $D(^DENT(221,"B",DENTDTE,DENTK1)) K ^DENT(221,"B",DENTDTE,DENTK1) S ^DENT(221,"B",$P(DENTK,"^",1),DENTI)=""
28 I $D(^DENT(221,"C",DENTPR,DENTK1)) K ^DENT(221,"C",DENTPR,DENTK1) S ^DENT(221,"C",DENTPR,DENTI)=""
29 I $D(^DENT(221,"D",DENTSSN,DENTK1)) K ^DENT(221,"D",DENTSSN,DENTK1) S ^DENT(221,"D",DENTSSN,DENTI)=""
30 I $D(^DENT(221,"E",DENTPA,DENTK1)) K ^DENT(221,"E",DENTPA,DENTK1) S ^DENT(221,"E",DENTPA,DENTI)=""
31 Q
Note: See TracBrowser for help on using the repository browser.