- 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 Feb 18, 2025@23:13:14 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