GMRCSUBS.m

GMRCSUBS ;SLC/dee - Routine to check if a Service has more that one parient service ;1/18/00

 ;;3.0;CONSULT/REQUEST TRACKING;**7**;DEC 27, 1997

 ;

 Q

EN ;Check the service hierarchy (file #123.5) for services

 ; that have more than are in more than one grouper.

 N SERVICE,PARENT,COUNT,NUMBER

 S NUMBER=0

 ;$Order though all Services

 S SERVICE=0

 F  S SERVICE=$O(^GMR(123.5,SERVICE)) Q:'+SERVICE  D

 . S PARENT=0

 . ;Check if they are a subservice to more than one service.

 . F COUNT=0:1 S PARENT=$O(^GMR(123.5,"APC",SERVICE,PARENT)) Q:'+PARENT  D

 .. ;

 . ;Print message about which services this service is a subservice of.

 . I COUNT>1 D

 .. W !,"Service ",$P(^GMR(123.5,SERVICE,0),"^",1)," is a sub service of:"

 .. S PARENT=0

 .. F  S PARENT=$O(^GMR(123.5,"APC",SERVICE,PARENT)) Q:'+PARENT  W !,"   ",$P(^GMR(123.5,PARENT,0),"^",1)

 .. S NUMBER=NUMBER+1

 ;Print totals.

 I NUMBER=0 W !!,"No Services are sub-services for more than one service."

 E  I NUMBER=1 W !!,"There is ",NUMBER," service that is a sub-service for more than one service."

 E  W !!,"There are ",NUMBER," services that are sub-services for more than one service."

 Q

 ;

CLEANAE ;Post-init for patch GMRC*3*7

 ;This will delete the AE cross-reference and then rebuild it.

 ;This is to make sure that the AE cross-reference does not contain

 ; any bad entries.

 N DIK

 K ^GMR(123,"AE")

 S DIK="^GMR(123,",DIK(1)="1^AE"

 D ENALL^DIK

 Q

 ;

POST ;Post install routine for patch 7

 D BMES^XPDUTL("Running POST^GMRCSUBS")

 D CLEANAE

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---GMRCSUBS   1551     printed  Apr 09, 2024@20:52:22                                                                                                                                                                                                    Page 2

GMRCSUBS  ;SLC/dee - Routine to check if a Service has more that one parient service ;1/18/00

 +1       ;;3.0;CONSULT/REQUEST TRACKING;**7**;DEC 27, 1997

 +2       ;

 +3        QUIT 

EN        ;Check the service hierarchy (file #123.5) for services

 +1       ; that have more than are in more than one grouper.

 +2        NEW SERVICE,PARENT,COUNT,NUMBER

 +3        SET NUMBER=0

 +4       ;$Order though all Services

 +5        SET SERVICE=0

 +6        FOR 

               SET SERVICE=$ORDER(^GMR(123.5,SERVICE))

               if '+SERVICE

                   QUIT 

               Begin DoDot:1

 +7                SET PARENT=0

 +8       ;Check if they are a subservice to more than one service.

 +9                FOR COUNT=0:1

                       SET PARENT=$ORDER(^GMR(123.5,"APC",SERVICE,PARENT))

                       if '+PARENT

                           QUIT 

                       Begin DoDot:2

 +10      ;

                       End DoDot:2

 +11      ;Print message about which services this service is a subservice of.

 +12               IF COUNT>1

                       Begin DoDot:2

 +13                       WRITE !,"Service ",$PIECE(^GMR(123.5,SERVICE,0),"^",1)," is a sub service of:"

 +14                       SET PARENT=0

 +15                       FOR 

                               SET PARENT=$ORDER(^GMR(123.5,"APC",SERVICE,PARENT))

                               if '+PARENT

                                   QUIT 

                               WRITE !,"   ",$PIECE(^GMR(123.5,PARENT,0),"^",1)

 +16                       SET NUMBER=NUMBER+1

                       End DoDot:2

               End DoDot:1

 +17      ;Print totals.

 +18       IF NUMBER=0

               WRITE !!,"No Services are sub-services for more than one service."

 +19      IF '$TEST

               IF NUMBER=1

                   WRITE !!,"There is ",NUMBER," service that is a sub-service for more than one service."

 +20      IF '$TEST

               WRITE !!,"There are ",NUMBER," services that are sub-services for more than one service."

 +21       QUIT 

 +22      ;

CLEANAE   ;Post-init for patch GMRC*3*7

 +1       ;This will delete the AE cross-reference and then rebuild it.

 +2       ;This is to make sure that the AE cross-reference does not contain

 +3       ; any bad entries.

 +4        NEW DIK

 +5        KILL ^GMR(123,"AE")

 +6        SET DIK="^GMR(123,"

           SET DIK(1)="1^AE"

 +7        DO ENALL^DIK

 +8        QUIT 

 +9       ;

POST      ;Post install routine for patch 7

 +1        DO BMES^XPDUTL("Running POST^GMRCSUBS")

 +2        DO CLEANAE

 +3        QUIT 

 +4       ;