source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCSUBS.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1GMRCSUBS ;SLC/dee - Routine to check if a Service has more that one parient service ;1/18/00
2 ;;3.0;CONSULT/REQUEST TRACKING;**7**;DEC 27, 1997
3 ;
4 Q
5EN ;Check the service hierarchy (file #123.5) for services
6 ; that have more than are in more than one grouper.
7 N SERVICE,PARENT,COUNT,NUMBER
8 S NUMBER=0
9 ;$Order though all Services
10 S SERVICE=0
11 F S SERVICE=$O(^GMR(123.5,SERVICE)) Q:'+SERVICE D
12 . S PARENT=0
13 . ;Check if they are a subservice to more than one service.
14 . F COUNT=0:1 S PARENT=$O(^GMR(123.5,"APC",SERVICE,PARENT)) Q:'+PARENT D
15 .. ;
16 . ;Print message about which services this service is a subservice of.
17 . I COUNT>1 D
18 .. W !,"Service ",$P(^GMR(123.5,SERVICE,0),"^",1)," is a sub service of:"
19 .. S PARENT=0
20 .. F S PARENT=$O(^GMR(123.5,"APC",SERVICE,PARENT)) Q:'+PARENT W !," ",$P(^GMR(123.5,PARENT,0),"^",1)
21 .. S NUMBER=NUMBER+1
22 ;Print totals.
23 I NUMBER=0 W !!,"No Services are sub-services for more than one service."
24 E I NUMBER=1 W !!,"There is ",NUMBER," service that is a sub-service for more than one service."
25 E W !!,"There are ",NUMBER," services that are sub-services for more than one service."
26 Q
27 ;
28CLEANAE ;Post-init for patch GMRC*3*7
29 ;This will delete the AE cross-reference and then rebuild it.
30 ;This is to make sure that the AE cross-reference does not contain
31 ; any bad entries.
32 N DIK
33 K ^GMR(123,"AE")
34 S DIK="^GMR(123,",DIK(1)="1^AE"
35 D ENALL^DIK
36 Q
37 ;
38POST ;Post install routine for patch 7
39 D BMES^XPDUTL("Running POST^GMRCSUBS")
40 D CLEANAE
41 Q
42 ;
Note: See TracBrowser for help on using the repository browser.