SCMCLN1.m

SCMCLN1 ;swo/iofobp cleanup utilities ;2.12.2007

 ;;5.3;Scheduling;**498**;8.13.1993;Build 23

 Q

INST ;check each teams institution and make sure it contains at least the

 ;stations base numeric identifier

 N SCMCSTA,SCMCL1,SCMCZN,SCMCV1,SCMCNT

 S SCMCSTA=$$NS^XUAF4(DUZ(2))

 I $G(DUZ(2))="" W !,"Institution is undefined...exiting",!! Q

 W !,"Your Station Name:  "_$P(SCMCSTA,U)

 W !,"           Number:  "_$P(SCMCSTA,U,2)

 W !,"This option will output a list of TEAMS whose Station Number association"

 W !,"does not match the number listed above.",!!

 S (SCMCL1,SCMCNT)=0

 F  S SCMCL1=$O(^SCTM(404.51,SCMCL1)) Q:'SCMCL1  D

 . S SCMCZN=$G(^SCTM(404.51,SCMCL1,0)) Q:SCMCZN=""

 . S SCMCV1=$E($P($G(^DIC(4,+$P(SCMCZN,U,7),99)),U),1,3) Q:SCMCV1=""

 . I $P(SCMCSTA,U,2)'=SCMCV1 D LOG

 . Q

 D SHOW,CLEAN

 Q

SHOW ;see what we got

 S DIOEND="D FOOT^SCMCLN1"

 S DIC="^SCTM(404.51,",L=0,BY="@.01",(FR,TO)="",FLDS=".01,.07,.07:99;""STATION #"""

 S BY(0)="^TMP(""SCMCLN1"",$J,"

 S L(0)=1 D EN1^DIP

 Q

LOG ;collect the entries with possible incorrect institution

 S ^TMP("SCMCLN1",$J,SCMCL1)=""

 S SCMCNT=SCMCNT+1

 Q

CLEAN ;clean up

 K ^TMP("SCMCLN1",$J)

 Q

FOOT ;summary footer

 I SCMCNT<1 W !!,"No problems found.",!! Q

 W !!,"The listed entries from the TEAM file need to be reviewed for Institution."

 W !,"PCMM GUI clients prior to SD*5.3*297 allowed Team association to any entry"

 W !,"in the Institution File."

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SCMCLN1   1450     printed  Mar 13, 2025@21:45:44                                                                                                                                                                                                     Page 2

SCMCLN1   ;swo/iofobp cleanup utilities ;2.12.2007

 +1       ;;5.3;Scheduling;**498**;8.13.1993;Build 23

 +2        QUIT 

INST      ;check each teams institution and make sure it contains at least the

 +1       ;stations base numeric identifier

 +2        NEW SCMCSTA,SCMCL1,SCMCZN,SCMCV1,SCMCNT

 +3        SET SCMCSTA=$$NS^XUAF4(DUZ(2))

 +4        IF $GET(DUZ(2))=""

               WRITE !,"Institution is undefined...exiting",!!

               QUIT 

 +5        WRITE !,"Your Station Name:  "_$PIECE(SCMCSTA,U)

 +6        WRITE !,"           Number:  "_$PIECE(SCMCSTA,U,2)

 +7        WRITE !,"This option will output a list of TEAMS whose Station Number association"

 +8        WRITE !,"does not match the number listed above.",!!

 +9        SET (SCMCL1,SCMCNT)=0

 +10       FOR 

               SET SCMCL1=$ORDER(^SCTM(404.51,SCMCL1))

               if 'SCMCL1

                   QUIT 

               Begin DoDot:1

 +11               SET SCMCZN=$GET(^SCTM(404.51,SCMCL1,0))

                   if SCMCZN=""

                       QUIT 

 +12               SET SCMCV1=$EXTRACT($PIECE($GET(^DIC(4,+$PIECE(SCMCZN,U,7),99)),U),1,3)

                   if SCMCV1=""

                       QUIT 

 +13               IF $PIECE(SCMCSTA,U,2)'=SCMCV1

                       DO LOG

 +14               QUIT 

               End DoDot:1

 +15       DO SHOW

           DO CLEAN

 +16       QUIT 

SHOW      ;see what we got

 +1        SET DIOEND="D FOOT^SCMCLN1"

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

           SET L=0

           SET BY="@.01"

           SET (FR,TO)=""

           SET FLDS=".01,.07,.07:99;""STATION #"""

 +3        SET BY(0)="^TMP(""SCMCLN1"",$J,"

 +4        SET L(0)=1

           DO EN1^DIP

 +5        QUIT 

LOG       ;collect the entries with possible incorrect institution

 +1        SET ^TMP("SCMCLN1",$JOB,SCMCL1)=""

 +2        SET SCMCNT=SCMCNT+1

 +3        QUIT 

CLEAN     ;clean up

 +1        KILL ^TMP("SCMCLN1",$JOB)

 +2        QUIT 

FOOT      ;summary footer

 +1        IF SCMCNT<1

               WRITE !!,"No problems found.",!!

               QUIT 

 +2        WRITE !!,"The listed entries from the TEAM file need to be reviewed for Institution."

 +3        WRITE !,"PCMM GUI clients prior to SD*5.3*297 allowed Team association to any entry"

 +4        WRITE !,"in the Institution File."

 +5        QUIT