SD53107P.m

SD53107P ;ALB/REV - PST-INST SD*5.3*107 UPDATE ^SC("TEAM" XREF 3/10/97 

 ;;5.3;SCHEDULING;**107**;AUG 13, 1993

EN ;

 N SCCLTM,DIK

 D BMES^XPDUTL("Beginning cleanup of team cross-reference in")

 D MES^XPDUTL("Hospital Location file . . .")

 D KILLOLD

 D ADDNEW

 D BMES^XPDUTL("Cross-references corrected!")

 Q

 ;

KILLOLD ;  if team in SC("TEAM" not in 404.51, kill the XREF entry

 D BMES^XPDUTL("Removing invalid cross-references.")

 S SCCLTM=""

 F  S SCCLTM=$O(^SC("TEAM",SCCLTM)) Q:SCCLTM=""  D

 .I '$D(^SCTM(404.51,"B",SCCLTM)) K ^SC("TEAM",SCCLTM)

 Q

 ;

ADDNEW ;  make sure each team with assoc clinics has an SC("TEAM" xref

 D BMES^XPDUTL("Updating cross-references from TEAM file.")

 S DIK="^SCTM(404.51,",DIK(1)=".01^ASCTEAM" D ENALL^DIK

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SD53107P   773     printed  Apr 09, 2024@21:40:56                                                                                                                                                                                                     Page 2

SD53107P  ;ALB/REV - PST-INST SD*5.3*107 UPDATE ^SC("TEAM" XREF 3/10/97 

 +1       ;;5.3;SCHEDULING;**107**;AUG 13, 1993

EN        ;

 +1        NEW SCCLTM,DIK

 +2        DO BMES^XPDUTL("Beginning cleanup of team cross-reference in")

 +3        DO MES^XPDUTL("Hospital Location file . . .")

 +4        DO KILLOLD

 +5        DO ADDNEW

 +6        DO BMES^XPDUTL("Cross-references corrected!")

 +7        QUIT 

 +8       ;

KILLOLD   ;  if team in SC("TEAM" not in 404.51, kill the XREF entry

 +1        DO BMES^XPDUTL("Removing invalid cross-references.")

 +2        SET SCCLTM=""

 +3        FOR 

               SET SCCLTM=$ORDER(^SC("TEAM",SCCLTM))

               if SCCLTM=""

                   QUIT 

               Begin DoDot:1

 +4                IF '$DATA(^SCTM(404.51,"B",SCCLTM))

                       KILL ^SC("TEAM",SCCLTM)

               End DoDot:1

 +5        QUIT 

 +6       ;

ADDNEW    ;  make sure each team with assoc clinics has an SC("TEAM" xref

 +1        DO BMES^XPDUTL("Updating cross-references from TEAM file.")

 +2        SET DIK="^SCTM(404.51,"

           SET DIK(1)=".01^ASCTEAM"

           DO ENALL^DIK

 +3        QUIT 

 +4       ;