| 1 | DENTUPD ; 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 | 
|---|
| 21 | RESET ; 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 | 
|---|