DENTUPD ; HISC/NCA - Update the Cross Reference ;4/15/96 09:27
;;1.2;DENTAL;**20,26**;Jan 26, 1996
Q:'$D(^DENT(221,DENTK1,0))
Q:$G(^DENT(221,DENTK1,.1))'=""
N DENTDTE,DENTF,DENTI,DENTK,DENTDI,DENTO,DENTPA,DENTPR,DENTSK,DENTSSN
S DENTK=$G(^DENT(221,DENTK1,0))
S DENTDTE=$P(DENTK,"^",1),DENTSSN=$P(DENTK,"^",2),DENTPR=$P(DENTK,"^",10),DENTPA=$P(DENTK,"^",4),DENTDI=$P(DENTK,"^",40)
S (DENTO,DENTSK)=9999999-DENTK1
Q:DENTSK=$P(DENTK,"^",1)
S DENTSK=$P(DENTK,"^",1)
S DENTF="",DENTF=$O(^DENT(221,"B",DENTSK,DENTF))
I DENTF="" G RESET
F D Q:DENTF="" ; Do it until empty
.S DENTF="",DENTSK=DENTSK+.000001 ; Add a second if date/time exist
.I $E(DENTSK,13,14)>59 S DENTSK=DENTSK+.000040
.I $E(DENTSK,11,12)>59 S DENTSK=DENTSK+.004000
.I $E(DENTSK,9,10)>23 S X1=DENTSK,X2=1 D C^%DTC S DENTSK=X
.S DENTF=$O(^DENT(221,"B",DENTSK,DENTF)) Q
S $P(DENTK,"^",1)=DENTSK
S DENTI=9999999-DENTSK K X,X1,X2
RESET ; Reset Node and Update the X'Ref
S ^DENT(221,DENTI,0)=DENTK K ^DENT(221,DENTK1,0)
K:$D(^DENT(221,"A",DENTDI,(DENTO\1),DENTK1)) ^DENT(221,"A",DENTDI,(DENTO\1),DENTK1) S ^DENT(221,"A",DENTDI,(DENTSK\1),DENTI)=""
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)=""
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)=""
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)=""
I $D(^DENT(221,"B",DENTDTE,DENTK1)) K ^DENT(221,"B",DENTDTE,DENTK1) S ^DENT(221,"B",$P(DENTK,"^",1),DENTI)=""
I $D(^DENT(221,"C",DENTPR,DENTK1)) K ^DENT(221,"C",DENTPR,DENTK1) S ^DENT(221,"C",DENTPR,DENTI)=""
I $D(^DENT(221,"D",DENTSSN,DENTK1)) K ^DENT(221,"D",DENTSSN,DENTK1) S ^DENT(221,"D",DENTSSN,DENTI)=""
I $D(^DENT(221,"E",DENTPA,DENTK1)) K ^DENT(221,"E",DENTPA,DENTK1) S ^DENT(221,"E",DENTPA,DENTI)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTUPD 2022 printed Dec 13, 2024@01:46:52 Page 2
DENTUPD ; HISC/NCA - Update the Cross Reference ;4/15/96 09:27
+1 ;;1.2;DENTAL;**20,26**;Jan 26, 1996
+2 if '$DATA(^DENT(221,DENTK1,0))
QUIT
+3 if $GET(^DENT(221,DENTK1,.1))'=""
QUIT
+4 NEW DENTDTE,DENTF,DENTI,DENTK,DENTDI,DENTO,DENTPA,DENTPR,DENTSK,DENTSSN
+5 SET DENTK=$GET(^DENT(221,DENTK1,0))
+6 SET DENTDTE=$PIECE(DENTK,"^",1)
SET DENTSSN=$PIECE(DENTK,"^",2)
SET DENTPR=$PIECE(DENTK,"^",10)
SET DENTPA=$PIECE(DENTK,"^",4)
SET DENTDI=$PIECE(DENTK,"^",40)
+7 SET (DENTO,DENTSK)=9999999-DENTK1
+8 if DENTSK=$PIECE(DENTK,"^",1)
QUIT
+9 SET DENTSK=$PIECE(DENTK,"^",1)
+10 SET DENTF=""
SET DENTF=$ORDER(^DENT(221,"B",DENTSK,DENTF))
+11 IF DENTF=""
GOTO RESET
+12 ; Do it until empty
FOR
Begin DoDot:1
+13 ; Add a second if date/time exist
SET DENTF=""
SET DENTSK=DENTSK+.000001
+14 IF $EXTRACT(DENTSK,13,14)>59
SET DENTSK=DENTSK+.000040
+15 IF $EXTRACT(DENTSK,11,12)>59
SET DENTSK=DENTSK+.004000
+16 IF $EXTRACT(DENTSK,9,10)>23
SET X1=DENTSK
SET X2=1
DO C^%DTC
SET DENTSK=X
+17 SET DENTF=$ORDER(^DENT(221,"B",DENTSK,DENTF))
QUIT
End DoDot:1
if DENTF=""
QUIT
+18 SET $PIECE(DENTK,"^",1)=DENTSK
+19 SET DENTI=9999999-DENTSK
KILL X,X1,X2
RESET ; Reset Node and Update the X'Ref
+1 SET ^DENT(221,DENTI,0)=DENTK
KILL ^DENT(221,DENTK1,0)
+2 if $DATA(^DENT(221,"A",DENTDI,(DENTO\1),DENTK1))
KILL ^DENT(221,"A",DENTDI,(DENTO\1),DENTK1)
SET ^DENT(221,"A",DENTDI,(DENTSK\1),DENTI)=""
+3 IF $DATA(^DENT(221,"A1",DENTDI,(DENTO\1),DENTK1))
KILL ^DENT(221,"A1",DENTDI,(DENTO\1),DENTK1)
SET ^DENT(221,"A1",DENTDI,(DENTSK\1),DENTI)=""
+4 if $DATA(^DENT(221,"AC",DENTDI,(DENTO\1),DENTPR,DENTK1))
KILL ^DENT(221,"AC",DENTDI,(DENTO\1),DENTPR,DENTK1)
SET ^DENT(221,"AC",DENTDI,(DENTSK\1),DENTPR,DENTI)=""
+5 IF $DATA(^DENT(221,"AC1",DENTDI,(DENTO\1),DENTPR,DENTK1))
KILL ^DENT(221,"AC1",DENTDI,(DENTO\1),DENTPR,DENTK1)
SET ^DENT(221,"AC1",DENTDI,(DENTSK\1),DENTPR,DENTI)=""
+6 IF $DATA(^DENT(221,"B",DENTDTE,DENTK1))
KILL ^DENT(221,"B",DENTDTE,DENTK1)
SET ^DENT(221,"B",$PIECE(DENTK,"^",1),DENTI)=""
+7 IF $DATA(^DENT(221,"C",DENTPR,DENTK1))
KILL ^DENT(221,"C",DENTPR,DENTK1)
SET ^DENT(221,"C",DENTPR,DENTI)=""
+8 IF $DATA(^DENT(221,"D",DENTSSN,DENTK1))
KILL ^DENT(221,"D",DENTSSN,DENTK1)
SET ^DENT(221,"D",DENTSSN,DENTI)=""
+9 IF $DATA(^DENT(221,"E",DENTPA,DENTK1))
KILL ^DENT(221,"E",DENTPA,DENTK1)
SET ^DENT(221,"E",DENTPA,DENTI)=""
+10 QUIT
