| [613] | 1 | SCMCLN1 ;swo/iofobp cleanup utilities ;2.12.2007
 | 
|---|
 | 2 |  ;;5.3;Scheduling;**498**;8.13.1993;Build 23
 | 
|---|
 | 3 |  Q
 | 
|---|
 | 4 | INST ;check each teams institution and make sure it contains at least the
 | 
|---|
 | 5 |  ;stations base numeric identifier
 | 
|---|
 | 6 |  N SCMCSTA,SCMCL1,SCMCZN,SCMCV1,SCMCNT
 | 
|---|
 | 7 |  S SCMCSTA=$$NS^XUAF4(DUZ(2))
 | 
|---|
 | 8 |  I $G(DUZ(2))="" W !,"Institution is undefined...exiting",!! Q
 | 
|---|
 | 9 |  W !,"Your Station Name:  "_$P(SCMCSTA,U)
 | 
|---|
 | 10 |  W !,"           Number:  "_$P(SCMCSTA,U,2)
 | 
|---|
 | 11 |  W !,"This option will output a list of TEAMS whose Station Number association"
 | 
|---|
 | 12 |  W !,"does not match the number listed above.",!!
 | 
|---|
 | 13 |  S (SCMCL1,SCMCNT)=0
 | 
|---|
 | 14 |  F  S SCMCL1=$O(^SCTM(404.51,SCMCL1)) Q:'SCMCL1  D
 | 
|---|
 | 15 |  . S SCMCZN=$G(^SCTM(404.51,SCMCL1,0)) Q:SCMCZN=""
 | 
|---|
 | 16 |  . S SCMCV1=$E($P($G(^DIC(4,+$P(SCMCZN,U,7),99)),U),1,3) Q:SCMCV1=""
 | 
|---|
 | 17 |  . I $P(SCMCSTA,U,2)'=SCMCV1 D LOG
 | 
|---|
 | 18 |  . Q
 | 
|---|
 | 19 |  D SHOW,CLEAN
 | 
|---|
 | 20 |  Q
 | 
|---|
 | 21 | SHOW ;see what we got
 | 
|---|
 | 22 |  S DIOEND="D FOOT^SCMCLN1"
 | 
|---|
 | 23 |  S DIC="^SCTM(404.51,",L=0,BY="@.01",(FR,TO)="",FLDS=".01,.07,.07:99;""STATION #"""
 | 
|---|
 | 24 |  S BY(0)="^TMP(""SCMCLN1"",$J,"
 | 
|---|
 | 25 |  S L(0)=1 D EN1^DIP
 | 
|---|
 | 26 |  Q
 | 
|---|
 | 27 | LOG ;collect the entries with possible incorrect institution
 | 
|---|
 | 28 |  S ^TMP("SCMCLN1",$J,SCMCL1)=""
 | 
|---|
 | 29 |  S SCMCNT=SCMCNT+1
 | 
|---|
 | 30 |  Q
 | 
|---|
 | 31 | CLEAN ;clean up
 | 
|---|
 | 32 |  K ^TMP("SCMCLN1",$J)
 | 
|---|
 | 33 |  Q
 | 
|---|
 | 34 | FOOT ;summary footer
 | 
|---|
 | 35 |  I SCMCNT<1 W !!,"No problems found.",!! Q
 | 
|---|
 | 36 |  W !!,"The listed entries from the TEAM file need to be reviewed for Institution."
 | 
|---|
 | 37 |  W !,"PCMM GUI clients prior to SD*5.3*297 allowed Team association to any entry"
 | 
|---|
 | 38 |  W !,"in the Institution File."
 | 
|---|
 | 39 |  Q
 | 
|---|