SD53P487.m

SD53P487 ;;BP OIFO/RJV Fix ASDCN xref.

 ;;5.3;Scheduling;**487,1015**;Aug 13, 1993;Build 21

 ;

 ;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

 ..I $P($G(^DPT(SDDFN,"S",SDAPDTE,0)),"^",1)="" Q

 ..S SC=$P(^DPT(SDDFN,"S",SDAPDTE,0),"^",1)

 ..S STATUS=$P($G(^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

SD53P487  ;;BP OIFO/RJV Fix ASDCN xref.

 +1       ;;5.3;Scheduling;**487,1015**;Aug 13, 1993;Build 21

 +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                        IF $PIECE($GET(^DPT(SDDFN,"S",SDAPDTE,0)),"^",1)=""

                               QUIT 

 +6                        SET SC=$PIECE(^DPT(SDDFN,"S",SDAPDTE,0),"^",1)

 +7                        SET STATUS=$PIECE($GET(^DPT(SDDFN,"S",SDAPDTE,0)),"^",2)

 +8                        IF STATUS["C"

                               IF '$DATA(^DPT("ASDCN",SC,SDAPDTE,SDDFN))

                                   Begin DoDot:3

 +9                                    SET ^DPT("ASDCN",SC,SDAPDTE,SDDFN)=$SELECT(STATUS["P":1,1:"")

                                   End DoDot:3

                       End DoDot:2

               End DoDot:1

 +10       QUIT