source: FOIAVistA/trunk/r/ENGINEERING-EN/ENEQRP6.m@ 1154

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

initial load of FOIAVistA 6/30/08 version

File size: 7.1 KB
Line 
1ENEQRP6 ;WIRMFO/SAB-PARENT SYSTEM/COMPONENT HIERARCHY REPORT ;6/4/97
2 ;;7.0;ENGINEERING;**35,42**;AUG 17, 1993
3EN ; main entry point
4ASKSYS ; ask system
5 S DIR(0)="Y",DIR("A")="Do you want a report for ALL systems"
6 S DIR("B")="NO"
7 S DIR("?",1)="Enter YES to generate a report for all systems."
8 S DIR("?",2)="The computer will identify all the topmost parent systems"
9 S DIR("?",3)="by looping through the entire equipment file. A complete"
10 S DIR("?",4)="system hierarchy will be printed for each of the topmost"
11 S DIR("?",5)="parent systems which includes all of their components."
12 S DIR("?",6)="It may take awhile to search the entire equipment file."
13 S DIR("?",7)=""
14 S DIR("?",8)="Enter NO to generate a report for just one system."
15 S DIR("?",9)=""
16 S DIR("?")="Enter YES or NO"
17 D ^DIR K DIR G:$D(DIRUT) EXIT
18 S EN("ALL")=Y
19 ;
20 I 'EN("ALL") F D G:ENDAP="^" EXIT Q:ENDAP]""
21 . S ENDAP=""
22 . D GETEQ^ENUTL I $D(DTOUT)!$D(DUOUT)!(Y'>0) S ENDAP="^" Q
23 . S ENDAP=+Y
24 . ; if entry is a component then offer to start with it's parent
25 . I $P($G(^ENG(6914,ENDAP,0)),U,3)]"" D Q:'ENDAP
26 . . S ENDA=ENDAP,I=0
27 . . F S X=$P($G(^ENG(6914,ENDA,0)),U,3) Q:X=""!(I>50) S ENDA=X,I=I+1
28 . . W:I>50 $C(7),!!,"Can't determine topmost parent system (>50 deep)."
29 . . I ENDAP'=ENDA D Q:ENDAP="^"
30 . . . W !!,"Equipment Entry #",ENDAP," ",$$GET1^DIQ(6914,ENDAP,6)
31 . . . W !,"is a component of Entry #",ENDA," ",$$GET1^DIQ(6914,ENDA,6)
32 . . . S DIR(0)="Y",DIR("B")="YES"
33 . . . S DIR("A")="Would you prefer to report on the parent system"
34 . . . S DIR("?")="Answer YES to start with the topmost parent system (includes components)."
35 . . . D ^DIR K DIR I $D(DIRUT) S ENDAP="^" Q
36 . . . I Y S ENDAP=ENDA
37 . ; make sure that selected system has components
38 . I '$O(^ENG(6914,"AE",ENDAP,0)) D Q:'ENDAP
39 . . W $C(7),!!,"Equipment Entry #",ENDAP," does not have any components"
40 . . S ENDAP=""
41 ;
42ASKFLD ; ask fields to print
43 K ENFLD F I=1:1:2 S ENFLD(I)=""
44 W !!,"Select the 1st field (required) to print for each equipment item."
45 K DIC S DIC="^DD(6914,",DIC(0)="AQEM",DIC("B")="EQUIPMENT CATEGORY"
46 S DIC("S")="I ($P(^(0),U,2)'[""W"")&($P(^(0),U,2)'>0)"
47 D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) G EXIT
48 I Y'>0 D G ASKFLD
49 . W $C(7),!!,"Select a field or enter '^' to quit."
50 S ENFLD(1)=+Y
51 S ENFLD(1,"L")=$$GET1^DID(6914,ENFLD(1),"","FIELD LENGTH")
52 S ENFLD(1,"N")=$$GET1^DID(6914,ENFLD(1),"","LABEL")
53 I ENFLD(1,"L")>20 D G:$D(DIRUT) EXIT
54 . W !!,"Field ",ENFLD(1,"N")," can be ",ENFLD(1,"L")," characters long."
55 . W !,"You may want to just print a portion of this field."
56 . S DIR(0)="N^1:"_ENFLD(1,"L")
57 . S DIR("A")="Number of characters to print",DIR("B")=20
58 . D ^DIR K DIR Q:$D(DIRUT)
59 . S ENFLD(1,"L")=Y
60 ;
61 W !!,"Select the 2nd field (optional) to print for each equipment item."
62 K DIC S DIC="^DD(6914,",DIC(0)="AQEM"
63 S DIC("S")="I ($P(^(0),U,2)'[""W"")&($P(^(0),U,2)'>0)"
64 D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) G EXIT
65 I Y>0 D G:$D(DIRUT) EXIT
66 . S ENFLD(2)=+Y
67 . S ENFLD(2,"L")=$$GET1^DID(6914,ENFLD(2),"","FIELD LENGTH")
68 . S ENFLD(2,"N")=$$GET1^DID(6914,ENFLD(2),"","LABEL")
69 . I ENFLD(2,"L")>20 D Q:$D(DIRUT)
70 . . W !!,"Field ",ENFLD(2,"N")," can be ",ENFLD(2,"L")," characters long."
71 . . W !,"You may want to just print a portion of this field."
72 . . S DIR(0)="N^1:"_ENFLD(2,"L")
73 . . S DIR("A")="Number of characters to print",DIR("B")=20
74 . . D ^DIR K DIR Q:$D(DIRUT)
75 . . S ENFLD(2,"L")=Y
76 ;
77ASKDEV ; ask device
78 S %ZIS="QM" D ^%ZIS G:POP EXIT
79 I $D(IO("Q")) D G EXIT
80 . S ZTRTN="QEN^ENEQRP6",ZTDESC="Parent System/Component Hierarchy Rpt"
81 . S ZTSAVE("ENDAP")="",ZTSAVE("ENFLD(")="",ZTSAVE("EN(")=""
82 . D ^%ZTLOAD,HOME^%ZIS K ZTSK
83 ;
84QEN ; queued entry point
85 U IO
86 S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
87 I 'EN("ALL") S ENDAP("CAT")=$$GET1^DIQ(6914,ENDAP,6)
88 K ENDL S $P(ENDL,"-",IOM+1)=""
89 K ENBL S $P(ENBL," ",IOM+1)=""
90 D HD
91 ;
92BLDHI ; build hierarchy
93 K ^TMP($J)
94 S ENRT="^TMP("_$J_","
95 S ENMD=1
96 I 'EN("ALL") D GETC(ENDAP,"",ENRT) S ENT=1
97 I EN("ALL") D G:END WRAPUP
98 . ; loop thru equipment, identify topmost parents, determine hierarchy
99 . S ENC=0,ENT=0,ENDA=0
100 . F S ENDA=$O(^ENG(6914,ENDA)) Q:'ENDA D Q:END
101 . . S ENC=ENC+1
102 . . I '(ENC#1000) W:IO=IO(0) "." I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,END)=1 Q
103 . . Q:'$O(^ENG(6914,"AE",ENDA,0)) ; not a parent system
104 . . Q:$P($G(^ENG(6914,ENDA,0)),U,3)'="" ; not the topmost parent system
105 . . D GETC(ENDA,"",ENRT) S ENT=ENT+1
106 ; save total number of topmost parents processed
107 S @(ENRT_0_")")="SYSTEM/COMPONENT LIST"_U_DT_U_ENT
108 ;
109PRTHI ; print hierarchy
110 ; compute indent to use for component levels
111 S Y=10+2+ENFLD(1,"L") ; ien and spaces and 1st field
112 S:ENFLD(2) Y=Y+3+ENFLD(2,"L") ; spaces and 2nd field
113 S ENIND=(IOM-Y)\ENMD
114 I ENIND>12 S ENIND=12
115 I ENIND<2 S ENIND=2
116 ;
117 S ENNODE=ENRT_0_")"
118 F S ENNODE=$Q(@ENNODE) Q:ENNODE="" Q:$QS(ENNODE,1)'=$J D Q:END
119 . S ENLVL=$QL(ENNODE),ENDA=$QS(ENNODE,ENLVL),ENC=+$G(@ENNODE)
120 . S ENCOL=ENIND*(ENLVL-2)
121 . I $Y+5>IOSL D HD Q:END D HDSYS
122 . S ENV(1)=$E($$GET1^DIQ(6914,ENDA,ENFLD(1)),1,ENFLD(1,"L"))
123 . S:ENFLD(2) ENV(2)=$E($$GET1^DIQ(6914,ENDA,ENFLD(2)),1,ENFLD(2,"L"))
124 . W !,?ENCOL,ENDA,?ENCOL+ENIND,ENV(1)
125 . W:ENFLD(2) $E(ENBL,1,ENFLD(1,"L")-$L(ENV(1)))," ",ENV(2)
126 . I ENC W " (",ENC," comp.)"
127WRAPUP ;
128 I END W !!,"REPORT STOPPED BY USER REQUEST"
129 E D
130 . W !!,"END OF REPORT"
131 . I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
132 D ^%ZISC
133 ;
134EXIT ;
135 I $D(ZTQUEUED) S ZTREQ="Q"
136 K ^TMP($J)
137 K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
138 K EN,ENC,ENCOL,ENDA,ENDAP,ENFLD,ENIND,ENLVL,ENMD,ENNODE,ENRT,ENT,ENV
139 K ENBL,END,ENDL,ENDT,ENPG
140 Q
141HD ; header
142 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,END)=1 Q
143 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
144 I $E(IOST,1,2)="C-"!ENPG W @IOF
145 S ENPG=ENPG+1
146 W !,"PARENT SYSTEM/COMPONENT HIERARCHY",?48,ENDT,?72,"page ",ENPG
147 W !,"for "
148 I EN("ALL") W "ALL SYSTEMS"
149 E W "SYSTEM with ENTRY #",ENDAP," ",ENDAP("CAT")
150 W !," print field(s): ",ENFLD(1,"N")
151 W:ENFLD(2) " and ",ENFLD(2,"N")
152 W !,ENDL
153 Q
154HDSYS ; header for continued system
155 F I=2:1:ENLVL-1 W !,?(ENIND*(I-2)),$QS(ENNODE,I)," (continued)"
156 Q
157 ;
158GETC(ENDAP,ENPL,ENRT) ; Get All Components Under a Parent System
159 ; Input
160 ; ENDAP - ien of parent system (e.g. 1024)
161 ; ENPL - ien list of parent systems above ENDAP (e.g. 150,7019,10,)
162 ; ENRT - root of array to store hierarchy in (e.g. X( or ^TMP($J,)
163 ; ENMD - maximum depth reached
164 ; Output
165 ; ENMD - maximum depth reached
166 ; ^TMP($J,parent ien)=# of components
167 ; ^TMP($J,parent ien,component ien)=""
168 N ENDAC,ENC,Y
169 ; init component counter
170 S ENC=0
171 ; loop thru components of parent system ENDAP
172 S ENDAC=0 F S ENDAC=$O(^ENG(6914,"AE",ENDAP,ENDAC)) Q:'ENDAC D
173 . ; check for endless loop
174 . I ","_ENPL_ENDAP_","[(","_ENDAC_",") D Q
175 . . W !,"ERROR - ENDLESS LOOP DETECTED - SKIPPING ENTRY"
176 . . W !," Entry #",ENDAC," already is a parent in ",ENPL_ENDAP_","
177 . ; save component
178 . S @(ENRT_ENPL_ENDAP_","_ENDAC_")")="",ENC=ENC+1
179 . ; see if previous maximum depth exceeded
180 . S Y=$L(ENPL_ENDAP_","_ENDAC,",") I Y>ENMD S ENMD=Y
181 . ; if component has components then get them also
182 . I $O(^ENG(6914,"AE",ENDAC,0)) D GETC(ENDAC,ENPL_ENDAP_",",ENRT)
183 ; save parent system component count
184 S @(ENRT_ENPL_ENDAP_")")=ENC
185 Q
186 ;ENEQRP6
Note: See TracBrowser for help on using the repository browser.