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 ---[H[J[2J[HSD53107P 773 printed Nov 22, 2024@17:54:43 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 ;
