SD53P389 ;;BP OIFO/RJV Fix ASDCN xref.
;;5.3;Scheduling;**389**;Aug 13, 1993
;
;Routine to loop thru appointments and if no xref for
;cancelled, create it.
;
Q
CHK ;
N STATUS,SC,SDDFN,SDAPDTE
S SDDFN=0,STATUS="",SC=""
F S SDDFN=$O(^DPT(SDDFN)) Q:+SDDFN=0 D
.S SDAPDTE=0 F S SDAPDTE=$O(^DPT(SDDFN,"S",SDAPDTE)) Q:SDAPDTE="" D
..S SC=$P(^DPT(SDDFN,"S",SDAPDTE,0),"^",1)
..S STATUS=$P(^DPT(SDDFN,"S",SDAPDTE,0),"^",2)
..I STATUS["C",'$D(^DPT("ASDCN",SC,SDAPDTE,SDDFN)) D
...W !,SDDFN_" - "_SDAPDTE_" - "_SC
Q
ASDCN ;
N STATUS,SC,SDDFN,SDAPDTE
S SDDFN=0,STATUS="",SC=""
F S SDDFN=$O(^DPT(SDDFN)) Q:+SDDFN=0 D
.S SDAPDTE=0 F S SDAPDTE=$O(^DPT(SDDFN,"S",SDAPDTE)) Q:SDAPDTE="" D
..S SC=$P(^DPT(SDDFN,"S",SDAPDTE,0),"^",1)
..S STATUS=$P(^DPT(SDDFN,"S",SDAPDTE,0),"^",2)
..I STATUS["C",'$D(^DPT("ASDCN",SC,SDAPDTE,SDDFN)) D
...S ^DPT("ASDCN",SC,SDAPDTE,SDDFN)=$S(STATUS["P":1,1:"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P389 935 printed Sep 23, 2025@20:22:39 Page 2
SD53P389 ;;BP OIFO/RJV Fix ASDCN xref.
+1 ;;5.3;Scheduling;**389**;Aug 13, 1993
+2 ;
+3 ;Routine to loop thru appointments and if no xref for
+4 ;cancelled, create it.
+5 ;
+6 QUIT
CHK ;
+1 NEW STATUS,SC,SDDFN,SDAPDTE
+2 SET SDDFN=0
SET STATUS=""
SET SC=""
+3 FOR
SET SDDFN=$ORDER(^DPT(SDDFN))
if +SDDFN=0
QUIT
Begin DoDot:1
+4 SET SDAPDTE=0
FOR
SET SDAPDTE=$ORDER(^DPT(SDDFN,"S",SDAPDTE))
if SDAPDTE=""
QUIT
Begin DoDot:2
+5 SET SC=$PIECE(^DPT(SDDFN,"S",SDAPDTE,0),"^",1)
+6 SET STATUS=$PIECE(^DPT(SDDFN,"S",SDAPDTE,0),"^",2)
+7 IF STATUS["C"
IF '$DATA(^DPT("ASDCN",SC,SDAPDTE,SDDFN))
Begin DoDot:3
+8 WRITE !,SDDFN_" - "_SDAPDTE_" - "_SC
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
ASDCN ;
+1 NEW STATUS,SC,SDDFN,SDAPDTE
+2 SET SDDFN=0
SET STATUS=""
SET SC=""
+3 FOR
SET SDDFN=$ORDER(^DPT(SDDFN))
if +SDDFN=0
QUIT
Begin DoDot:1
+4 SET SDAPDTE=0
FOR
SET SDAPDTE=$ORDER(^DPT(SDDFN,"S",SDAPDTE))
if SDAPDTE=""
QUIT
Begin DoDot:2
+5 SET SC=$PIECE(^DPT(SDDFN,"S",SDAPDTE,0),"^",1)
+6 SET STATUS=$PIECE(^DPT(SDDFN,"S",SDAPDTE,0),"^",2)
+7 IF STATUS["C"
IF '$DATA(^DPT("ASDCN",SC,SDAPDTE,SDDFN))
Begin DoDot:3
+8 SET ^DPT("ASDCN",SC,SDAPDTE,SDDFN)=$SELECT(STATUS["P":1,1:"")
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
