source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENLIB4.m@ 767

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1ENLIB4 ;(WASH IRMFO)/DH-Package Utilities (Facility Equip) ;9.29.98
2 ;;7.0;ENGINEERING;**55**;Aug 17,1993
3 ;
4ADDUS ; Maintain the utility system field down the parent/child hierarchy
5 ; Called at set of field #82 in file #6914
6 ; Uses recursion to climb up and down the "AE" x-ref
7 ; Will not maintain local x-refs on field #82
8 N COUNT,PARNT,PRECRSR
9 S COUNT=0,PRECRSR="" I $O(^ENG(6914,"AE",DA,0)) D ADRCRSN(DA,PRECRSR)
10 I COUNT D EN^DDIOL(COUNT_" subsidiary records were set.") I $D(DJJ(21)) H 5 ; causes the old eng dj screen handler to pause
11 Q
12 ;
13ADRCRSN(PARNT,PRECRSR) ; navigate the "AE" x-ref
14 N CHILD
15 S CHILD=0 F S CHILD=$O(^ENG(6914,"AE",PARNT,CHILD)) Q:'CHILD D
16 . Q:","_PRECRSR_PARNT_","[(","_CHILD_",") ; avoid the endless loop
17 . S $P(^ENG(6914,CHILD,9),U,12)=X,COUNT=COUNT+1
18 . ; if child has children then keep digging
19 . I $O(^ENG(6914,"AE",CHILD,0)) D ADRCRSN(CHILD,PRECRSR_PARNT_",")
20 Q
21 ;
22KILLUS ; Maintain the utility system field down the parent/child hierarchy
23 ; Called at kill
24 N PARNT,PRECRSR
25 S PRECRSR="" I $O(^ENG(6914,"AE",DA,0)) D KLRCRSN(DA,PRECRSR)
26 Q
27 ;
28KLRCRSN(PARNT,PRECRSR) ; navigate the "AE" x-ref, deleting utility systems field of all the children
29 N CHILD
30 S CHILD=0 F S CHILD=$O(^ENG(6914,"AE",PARNT,CHILD)) Q:'CHILD D
31 . Q:","_PRECRSR_PARNT_","[(","_CHILD_",") ; avoid the endless loop
32 . S $P(^ENG(6914,CHILD,9),U,12)=""
33 . ; if child has children then keep digging
34 . I $O(^ENG(6914,"AE",CHILD,0)) D KLRCRSN(CHILD,PRECRSR_PARNT_",")
35 Q
36 ;
37EDITY2 ; called upon edit of Y2K category, restricts screen edits
38 Q:$P($G(DJJ(25)),U,3)'=71 ; quit if not screen edit
39 I $G(V(25))="","FC^NA"[X Q ; for screen edit to work, existing entry must be null and selected entry must be NA or FC
40 D EN^DDIOL("You must use the Y2K module for this edit.")
41 S X=$$GET1^DIQ(6914,DA,71,"I") H 5
42 Q
43 ;ENLIB4
Note: See TracBrowser for help on using the repository browser.