1 | ENLIB4 ;(WASH IRMFO)/DH-Package Utilities (Facility Equip) ;9.29.98
|
---|
2 | ;;7.0;ENGINEERING;**55**;Aug 17,1993
|
---|
3 | ;
|
---|
4 | ADDUS ; 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 | ;
|
---|
13 | ADRCRSN(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 | ;
|
---|
22 | KILLUS ; 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 | ;
|
---|
28 | KLRCRSN(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 | ;
|
---|
37 | EDITY2 ; 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
|
---|