- 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 ---[H[J[2J[HGMRCSUBS 1551 printed Feb 18, 2025@23:13:55 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 ;
