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
|
---|