Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCSUBS

GMRCSUBS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. EN ;Check the service hierarchy (file #123.5) for services
  1. ; that have more than are in more than one grouper.
  1. N SERVICE,PARENT,COUNT,NUMBER
  1. S NUMBER=0
  1. ;$Order though all Services
  1. S SERVICE=0
  1. F S SERVICE=$O(^GMR(123.5,SERVICE)) Q:'+SERVICE D
  1. . S PARENT=0
  1. . ;Check if they are a subservice to more than one service.
  1. . F COUNT=0:1 S PARENT=$O(^GMR(123.5,"APC",SERVICE,PARENT)) Q:'+PARENT D
  1. .. ;
  1. . ;Print message about which services this service is a subservice of.
  1. . I COUNT>1 D
  1. .. W !,"Service ",$P(^GMR(123.5,SERVICE,0),"^",1)," is a sub service of:"
  1. .. S PARENT=0
  1. .. F S PARENT=$O(^GMR(123.5,"APC",SERVICE,PARENT)) Q:'+PARENT W !," ",$P(^GMR(123.5,PARENT,0),"^",1)
  1. .. S NUMBER=NUMBER+1
  1. ;Print totals.
  1. I NUMBER=0 W !!,"No Services are sub-services for more than one service."
  1. E I NUMBER=1 W !!,"There is ",NUMBER," service that is a sub-service for more than one service."
  1. E W !!,"There are ",NUMBER," services that are sub-services for more than one service."
  1. Q
  1. ;
  1. CLEANAE ;Post-init for patch GMRC*3*7
  1. ;This will delete the AE cross-reference and then rebuild it.
  1. ;This is to make sure that the AE cross-reference does not contain
  1. ; any bad entries.
  1. N DIK
  1. K ^GMR(123,"AE")
  1. S DIK="^GMR(123,",DIK(1)="1^AE"
  1. D ENALL^DIK
  1. Q
  1. ;
  1. POST ;Post install routine for patch 7
  1. D BMES^XPDUTL("Running POST^GMRCSUBS")
  1. D CLEANAE
  1. Q
  1. ;