ENEQRP6 ;WIRMFO/SAB-PARENT SYSTEM/COMPONENT HIERARCHY REPORT ;6/4/97
;;7.0;ENGINEERING;**35,42**;AUG 17, 1993
EN ; main entry point
ASKSYS ; ask system
S DIR(0)="Y",DIR("A")="Do you want a report for ALL systems"
S DIR("B")="NO"
S DIR("?",1)="Enter YES to generate a report for all systems."
S DIR("?",2)="The computer will identify all the topmost parent systems"
S DIR("?",3)="by looping through the entire equipment file. A complete"
S DIR("?",4)="system hierarchy will be printed for each of the topmost"
S DIR("?",5)="parent systems which includes all of their components."
S DIR("?",6)="It may take awhile to search the entire equipment file."
S DIR("?",7)=""
S DIR("?",8)="Enter NO to generate a report for just one system."
S DIR("?",9)=""
S DIR("?")="Enter YES or NO"
D ^DIR K DIR G:$D(DIRUT) EXIT
S EN("ALL")=Y
;
I 'EN("ALL") F D G:ENDAP="^" EXIT Q:ENDAP]""
. S ENDAP=""
. D GETEQ^ENUTL I $D(DTOUT)!$D(DUOUT)!(Y'>0) S ENDAP="^" Q
. S ENDAP=+Y
. ; if entry is a component then offer to start with it's parent
. I $P($G(^ENG(6914,ENDAP,0)),U,3)]"" D Q:'ENDAP
. . S ENDA=ENDAP,I=0
. . F S X=$P($G(^ENG(6914,ENDA,0)),U,3) Q:X=""!(I>50) S ENDA=X,I=I+1
. . W:I>50 $C(7),!!,"Can't determine topmost parent system (>50 deep)."
. . I ENDAP'=ENDA D Q:ENDAP="^"
. . . W !!,"Equipment Entry #",ENDAP," ",$$GET1^DIQ(6914,ENDAP,6)
. . . W !,"is a component of Entry #",ENDA," ",$$GET1^DIQ(6914,ENDA,6)
. . . S DIR(0)="Y",DIR("B")="YES"
. . . S DIR("A")="Would you prefer to report on the parent system"
. . . S DIR("?")="Answer YES to start with the topmost parent system (includes components)."
. . . D ^DIR K DIR I $D(DIRUT) S ENDAP="^" Q
. . . I Y S ENDAP=ENDA
. ; make sure that selected system has components
. I '$O(^ENG(6914,"AE",ENDAP,0)) D Q:'ENDAP
. . W $C(7),!!,"Equipment Entry #",ENDAP," does not have any components"
. . S ENDAP=""
;
ASKFLD ; ask fields to print
K ENFLD F I=1:1:2 S ENFLD(I)=""
W !!,"Select the 1st field (required) to print for each equipment item."
K DIC S DIC="^DD(6914,",DIC(0)="AQEM",DIC("B")="EQUIPMENT CATEGORY"
S DIC("S")="I ($P(^(0),U,2)'[""W"")&($P(^(0),U,2)'>0)"
D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) G EXIT
I Y'>0 D G ASKFLD
. W $C(7),!!,"Select a field or enter '^' to quit."
S ENFLD(1)=+Y
S ENFLD(1,"L")=$$GET1^DID(6914,ENFLD(1),"","FIELD LENGTH")
S ENFLD(1,"N")=$$GET1^DID(6914,ENFLD(1),"","LABEL")
I ENFLD(1,"L")>20 D G:$D(DIRUT) EXIT
. W !!,"Field ",ENFLD(1,"N")," can be ",ENFLD(1,"L")," characters long."
. W !,"You may want to just print a portion of this field."
. S DIR(0)="N^1:"_ENFLD(1,"L")
. S DIR("A")="Number of characters to print",DIR("B")=20
. D ^DIR K DIR Q:$D(DIRUT)
. S ENFLD(1,"L")=Y
;
W !!,"Select the 2nd field (optional) to print for each equipment item."
K DIC S DIC="^DD(6914,",DIC(0)="AQEM"
S DIC("S")="I ($P(^(0),U,2)'[""W"")&($P(^(0),U,2)'>0)"
D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) G EXIT
I Y>0 D G:$D(DIRUT) EXIT
. S ENFLD(2)=+Y
. S ENFLD(2,"L")=$$GET1^DID(6914,ENFLD(2),"","FIELD LENGTH")
. S ENFLD(2,"N")=$$GET1^DID(6914,ENFLD(2),"","LABEL")
. I ENFLD(2,"L")>20 D Q:$D(DIRUT)
. . W !!,"Field ",ENFLD(2,"N")," can be ",ENFLD(2,"L")," characters long."
. . W !,"You may want to just print a portion of this field."
. . S DIR(0)="N^1:"_ENFLD(2,"L")
. . S DIR("A")="Number of characters to print",DIR("B")=20
. . D ^DIR K DIR Q:$D(DIRUT)
. . S ENFLD(2,"L")=Y
;
ASKDEV ; ask device
S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENEQRP6",ZTDESC="Parent System/Component Hierarchy Rpt"
. S ZTSAVE("ENDAP")="",ZTSAVE("ENFLD(")="",ZTSAVE("EN(")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
;
QEN ; queued entry point
U IO
S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
I 'EN("ALL") S ENDAP("CAT")=$$GET1^DIQ(6914,ENDAP,6)
K ENDL S $P(ENDL,"-",IOM+1)=""
K ENBL S $P(ENBL," ",IOM+1)=""
D HD
;
BLDHI ; build hierarchy
K ^TMP($J)
S ENRT="^TMP("_$J_","
S ENMD=1
I 'EN("ALL") D GETC(ENDAP,"",ENRT) S ENT=1
I EN("ALL") D G:END WRAPUP
. ; loop thru equipment, identify topmost parents, determine hierarchy
. S ENC=0,ENT=0,ENDA=0
. F S ENDA=$O(^ENG(6914,ENDA)) Q:'ENDA D Q:END
. . S ENC=ENC+1
. . I '(ENC#1000) W:IO=IO(0) "." I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,END)=1 Q
. . Q:'$O(^ENG(6914,"AE",ENDA,0)) ; not a parent system
. . Q:$P($G(^ENG(6914,ENDA,0)),U,3)'="" ; not the topmost parent system
. . D GETC(ENDA,"",ENRT) S ENT=ENT+1
; save total number of topmost parents processed
S @(ENRT_0_")")="SYSTEM/COMPONENT LIST"_U_DT_U_ENT
;
PRTHI ; print hierarchy
; compute indent to use for component levels
S Y=10+2+ENFLD(1,"L") ; ien and spaces and 1st field
S:ENFLD(2) Y=Y+3+ENFLD(2,"L") ; spaces and 2nd field
S ENIND=(IOM-Y)\ENMD
I ENIND>12 S ENIND=12
I ENIND<2 S ENIND=2
;
S ENNODE=ENRT_0_")"
F S ENNODE=$Q(@ENNODE) Q:ENNODE="" Q:$QS(ENNODE,1)'=$J D Q:END
. S ENLVL=$QL(ENNODE),ENDA=$QS(ENNODE,ENLVL),ENC=+$G(@ENNODE)
. S ENCOL=ENIND*(ENLVL-2)
. I $Y+5>IOSL D HD Q:END D HDSYS
. S ENV(1)=$E($$GET1^DIQ(6914,ENDA,ENFLD(1)),1,ENFLD(1,"L"))
. S:ENFLD(2) ENV(2)=$E($$GET1^DIQ(6914,ENDA,ENFLD(2)),1,ENFLD(2,"L"))
. W !,?ENCOL,ENDA,?ENCOL+ENIND,ENV(1)
. W:ENFLD(2) $E(ENBL,1,ENFLD(1,"L")-$L(ENV(1)))," ",ENV(2)
. I ENC W " (",ENC," comp.)"
WRAPUP ;
I END W !!,"REPORT STOPPED BY USER REQUEST"
E D
. W !!,"END OF REPORT"
. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
D ^%ZISC
;
EXIT ;
I $D(ZTQUEUED) S ZTREQ="Q"
K ^TMP($J)
K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
K EN,ENC,ENCOL,ENDA,ENDAP,ENFLD,ENIND,ENLVL,ENMD,ENNODE,ENRT,ENT,ENV
K ENBL,END,ENDL,ENDT,ENPG
Q
HD ; header
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,END)=1 Q
I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
I $E(IOST,1,2)="C-"!ENPG W @IOF
S ENPG=ENPG+1
W !,"PARENT SYSTEM/COMPONENT HIERARCHY",?48,ENDT,?72,"page ",ENPG
W !,"for "
I EN("ALL") W "ALL SYSTEMS"
E W "SYSTEM with ENTRY #",ENDAP," ",ENDAP("CAT")
W !," print field(s): ",ENFLD(1,"N")
W:ENFLD(2) " and ",ENFLD(2,"N")
W !,ENDL
Q
HDSYS ; header for continued system
F I=2:1:ENLVL-1 W !,?(ENIND*(I-2)),$QS(ENNODE,I)," (continued)"
Q
;
GETC(ENDAP,ENPL,ENRT) ; Get All Components Under a Parent System
; Input
; ENDAP - ien of parent system (e.g. 1024)
; ENPL - ien list of parent systems above ENDAP (e.g. 150,7019,10,)
; ENRT - root of array to store hierarchy in (e.g. X( or ^TMP($J,)
; ENMD - maximum depth reached
; Output
; ENMD - maximum depth reached
; ^TMP($J,parent ien)=# of components
; ^TMP($J,parent ien,component ien)=""
N ENDAC,ENC,Y
; init component counter
S ENC=0
; loop thru components of parent system ENDAP
S ENDAC=0 F S ENDAC=$O(^ENG(6914,"AE",ENDAP,ENDAC)) Q:'ENDAC D
. ; check for endless loop
. I ","_ENPL_ENDAP_","[(","_ENDAC_",") D Q
. . W !,"ERROR - ENDLESS LOOP DETECTED - SKIPPING ENTRY"
. . W !," Entry #",ENDAC," already is a parent in ",ENPL_ENDAP_","
. ; save component
. S @(ENRT_ENPL_ENDAP_","_ENDAC_")")="",ENC=ENC+1
. ; see if previous maximum depth exceeded
. S Y=$L(ENPL_ENDAP_","_ENDAC,",") I Y>ENMD S ENMD=Y
. ; if component has components then get them also
. I $O(^ENG(6914,"AE",ENDAC,0)) D GETC(ENDAC,ENPL_ENDAP_",",ENRT)
; save parent system component count
S @(ENRT_ENPL_ENDAP_")")=ENC
Q
;ENEQRP6
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQRP6 7449 printed Dec 13, 2024@01:53:06 Page 2
ENEQRP6 ;WIRMFO/SAB-PARENT SYSTEM/COMPONENT HIERARCHY REPORT ;6/4/97
+1 ;;7.0;ENGINEERING;**35,42**;AUG 17, 1993
EN ; main entry point
ASKSYS ; ask system
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want a report for ALL systems"
+2 SET DIR("B")="NO"
+3 SET DIR("?",1)="Enter YES to generate a report for all systems."
+4 SET DIR("?",2)="The computer will identify all the topmost parent systems"
+5 SET DIR("?",3)="by looping through the entire equipment file. A complete"
+6 SET DIR("?",4)="system hierarchy will be printed for each of the topmost"
+7 SET DIR("?",5)="parent systems which includes all of their components."
+8 SET DIR("?",6)="It may take awhile to search the entire equipment file."
+9 SET DIR("?",7)=""
+10 SET DIR("?",8)="Enter NO to generate a report for just one system."
+11 SET DIR("?",9)=""
+12 SET DIR("?")="Enter YES or NO"
+13 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+14 SET EN("ALL")=Y
+15 ;
+16 IF 'EN("ALL")
FOR
Begin DoDot:1
+17 SET ENDAP=""
+18 DO GETEQ^ENUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y'>0)
SET ENDAP="^"
QUIT
+19 SET ENDAP=+Y
+20 ; if entry is a component then offer to start with it's parent
+21 IF $PIECE($GET(^ENG(6914,ENDAP,0)),U,3)]""
Begin DoDot:2
+22 SET ENDA=ENDAP
SET I=0
+23 FOR
SET X=$PIECE($GET(^ENG(6914,ENDA,0)),U,3)
if X=""!(I>50)
QUIT
SET ENDA=X
SET I=I+1
+24 if I>50
WRITE $CHAR(7),!!,"Can't determine topmost parent system (>50 deep)."
+25 IF ENDAP'=ENDA
Begin DoDot:3
+26 WRITE !!,"Equipment Entry #",ENDAP," ",$$GET1^DIQ(6914,ENDAP,6)
+27 WRITE !,"is a component of Entry #",ENDA," ",$$GET1^DIQ(6914,ENDA,6)
+28 SET DIR(0)="Y"
SET DIR("B")="YES"
+29 SET DIR("A")="Would you prefer to report on the parent system"
+30 SET DIR("?")="Answer YES to start with the topmost parent system (includes components)."
+31 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ENDAP="^"
QUIT
+32 IF Y
SET ENDAP=ENDA
End DoDot:3
if ENDAP="^"
QUIT
End DoDot:2
if 'ENDAP
QUIT
+33 ; make sure that selected system has components
+34 IF '$ORDER(^ENG(6914,"AE",ENDAP,0))
Begin DoDot:2
+35 WRITE $CHAR(7),!!,"Equipment Entry #",ENDAP," does not have any components"
+36 SET ENDAP=""
End DoDot:2
if 'ENDAP
QUIT
End DoDot:1
if ENDAP="^"
GOTO EXIT
if ENDAP]""
QUIT
+37 ;
ASKFLD ; ask fields to print
+1 KILL ENFLD
FOR I=1:1:2
SET ENFLD(I)=""
+2 WRITE !!,"Select the 1st field (required) to print for each equipment item."
+3 KILL DIC
SET DIC="^DD(6914,"
SET DIC(0)="AQEM"
SET DIC("B")="EQUIPMENT CATEGORY"
+4 SET DIC("S")="I ($P(^(0),U,2)'[""W"")&($P(^(0),U,2)'>0)"
+5 DO ^DIC
KILL DIC
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+6 IF Y'>0
Begin DoDot:1
+7 WRITE $CHAR(7),!!,"Select a field or enter '^' to quit."
End DoDot:1
GOTO ASKFLD
+8 SET ENFLD(1)=+Y
+9 SET ENFLD(1,"L")=$$GET1^DID(6914,ENFLD(1),"","FIELD LENGTH")
+10 SET ENFLD(1,"N")=$$GET1^DID(6914,ENFLD(1),"","LABEL")
+11 IF ENFLD(1,"L")>20
Begin DoDot:1
+12 WRITE !!,"Field ",ENFLD(1,"N")," can be ",ENFLD(1,"L")," characters long."
+13 WRITE !,"You may want to just print a portion of this field."
+14 SET DIR(0)="N^1:"_ENFLD(1,"L")
+15 SET DIR("A")="Number of characters to print"
SET DIR("B")=20
+16 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+17 SET ENFLD(1,"L")=Y
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+18 ;
+19 WRITE !!,"Select the 2nd field (optional) to print for each equipment item."
+20 KILL DIC
SET DIC="^DD(6914,"
SET DIC(0)="AQEM"
+21 SET DIC("S")="I ($P(^(0),U,2)'[""W"")&($P(^(0),U,2)'>0)"
+22 DO ^DIC
KILL DIC
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
+23 IF Y>0
Begin DoDot:1
+24 SET ENFLD(2)=+Y
+25 SET ENFLD(2,"L")=$$GET1^DID(6914,ENFLD(2),"","FIELD LENGTH")
+26 SET ENFLD(2,"N")=$$GET1^DID(6914,ENFLD(2),"","LABEL")
+27 IF ENFLD(2,"L")>20
Begin DoDot:2
+28 WRITE !!,"Field ",ENFLD(2,"N")," can be ",ENFLD(2,"L")," characters long."
+29 WRITE !,"You may want to just print a portion of this field."
+30 SET DIR(0)="N^1:"_ENFLD(2,"L")
+31 SET DIR("A")="Number of characters to print"
SET DIR("B")=20
+32 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+33 SET ENFLD(2,"L")=Y
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+34 ;
ASKDEV ; ask device
+1 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET ZTRTN="QEN^ENEQRP6"
SET ZTDESC="Parent System/Component Hierarchy Rpt"
+4 SET ZTSAVE("ENDAP")=""
SET ZTSAVE("ENFLD(")=""
SET ZTSAVE("EN(")=""
+5 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+6 ;
QEN ; queued entry point
+1 USE IO
+2 SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENDT=Y
+3 IF 'EN("ALL")
SET ENDAP("CAT")=$$GET1^DIQ(6914,ENDAP,6)
+4 KILL ENDL
SET $PIECE(ENDL,"-",IOM+1)=""
+5 KILL ENBL
SET $PIECE(ENBL," ",IOM+1)=""
+6 DO HD
+7 ;
BLDHI ; build hierarchy
+1 KILL ^TMP($JOB)
+2 SET ENRT="^TMP("_$JOB_","
+3 SET ENMD=1
+4 IF 'EN("ALL")
DO GETC(ENDAP,"",ENRT)
SET ENT=1
+5 IF EN("ALL")
Begin DoDot:1
+6 ; loop thru equipment, identify topmost parents, determine hierarchy
+7 SET ENC=0
SET ENT=0
SET ENDA=0
+8 FOR
SET ENDA=$ORDER(^ENG(6914,ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+9 SET ENC=ENC+1
+10 IF '(ENC#1000)
if IO=IO(0)
WRITE "."
IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,END)=1
QUIT
+11 ; not a parent system
if '$ORDER(^ENG(6914,"AE",ENDA,0))
QUIT
+12 ; not the topmost parent system
if $PIECE($GET(^ENG(6914,ENDA,0)),U,3)'=""
QUIT
+13 DO GETC(ENDA,"",ENRT)
SET ENT=ENT+1
End DoDot:2
if END
QUIT
End DoDot:1
if END
GOTO WRAPUP
+14 ; save total number of topmost parents processed
+15 SET @(ENRT_0_")")="SYSTEM/COMPONENT LIST"_U_DT_U_ENT
+16 ;
PRTHI ; print hierarchy
+1 ; compute indent to use for component levels
+2 ; ien and spaces and 1st field
SET Y=10+2+ENFLD(1,"L")
+3 ; spaces and 2nd field
if ENFLD(2)
SET Y=Y+3+ENFLD(2,"L")
+4 SET ENIND=(IOM-Y)\ENMD
+5 IF ENIND>12
SET ENIND=12
+6 IF ENIND<2
SET ENIND=2
+7 ;
+8 SET ENNODE=ENRT_0_")"
+9 FOR
SET ENNODE=$QUERY(@ENNODE)
if ENNODE=""
QUIT
if $QSUBSCRIPT(ENNODE,1)'=$JOB
QUIT
Begin DoDot:1
+10 SET ENLVL=$QLENGTH(ENNODE)
SET ENDA=$QSUBSCRIPT(ENNODE,ENLVL)
SET ENC=+$GET(@ENNODE)
+11 SET ENCOL=ENIND*(ENLVL-2)
+12 IF $Y+5>IOSL
DO HD
if END
QUIT
DO HDSYS
+13 SET ENV(1)=$EXTRACT($$GET1^DIQ(6914,ENDA,ENFLD(1)),1,ENFLD(1,"L"))
+14 if ENFLD(2)
SET ENV(2)=$EXTRACT($$GET1^DIQ(6914,ENDA,ENFLD(2)),1,ENFLD(2,"L"))
+15 WRITE !,?ENCOL,ENDA,?ENCOL+ENIND,ENV(1)
+16 if ENFLD(2)
WRITE $EXTRACT(ENBL,1,ENFLD(1,"L")-$LENGTH(ENV(1)))," ",ENV(2)
+17 IF ENC
WRITE " (",ENC," comp.)"
End DoDot:1
if END
QUIT
WRAPUP ;
+1 IF END
WRITE !!,"REPORT STOPPED BY USER REQUEST"
+2 IF '$TEST
Begin DoDot:1
+3 WRITE !!,"END OF REPORT"
+4 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+5 DO ^%ZISC
+6 ;
EXIT ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="Q"
+2 KILL ^TMP($JOB)
+3 KILL DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+4 KILL EN,ENC,ENCOL,ENDA,ENDAP,ENFLD,ENIND,ENLVL,ENMD,ENNODE,ENRT,ENT,ENV
+5 KILL ENBL,END,ENDL,ENDT,ENPG
+6 QUIT
HD ; header
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,END)=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
IF ENPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET END=1
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"!ENPG
WRITE @IOF
+4 SET ENPG=ENPG+1
+5 WRITE !,"PARENT SYSTEM/COMPONENT HIERARCHY",?48,ENDT,?72,"page ",ENPG
+6 WRITE !,"for "
+7 IF EN("ALL")
WRITE "ALL SYSTEMS"
+8 IF '$TEST
WRITE "SYSTEM with ENTRY #",ENDAP," ",ENDAP("CAT")
+9 WRITE !," print field(s): ",ENFLD(1,"N")
+10 if ENFLD(2)
WRITE " and ",ENFLD(2,"N")
+11 WRITE !,ENDL
+12 QUIT
HDSYS ; header for continued system
+1 FOR I=2:1:ENLVL-1
WRITE !,?(ENIND*(I-2)),$QSUBSCRIPT(ENNODE,I)," (continued)"
+2 QUIT
+3 ;
GETC(ENDAP,ENPL,ENRT) ; Get All Components Under a Parent System
+1 ; Input
+2 ; ENDAP - ien of parent system (e.g. 1024)
+3 ; ENPL - ien list of parent systems above ENDAP (e.g. 150,7019,10,)
+4 ; ENRT - root of array to store hierarchy in (e.g. X( or ^TMP($J,)
+5 ; ENMD - maximum depth reached
+6 ; Output
+7 ; ENMD - maximum depth reached
+8 ; ^TMP($J,parent ien)=# of components
+9 ; ^TMP($J,parent ien,component ien)=""
+10 NEW ENDAC,ENC,Y
+11 ; init component counter
+12 SET ENC=0
+13 ; loop thru components of parent system ENDAP
+14 SET ENDAC=0
FOR
SET ENDAC=$ORDER(^ENG(6914,"AE",ENDAP,ENDAC))
if 'ENDAC
QUIT
Begin DoDot:1
+15 ; check for endless loop
+16 IF ","_ENPL_ENDAP_","[(","_ENDAC_",")
Begin DoDot:2
+17 WRITE !,"ERROR - ENDLESS LOOP DETECTED - SKIPPING ENTRY"
+18 WRITE !," Entry #",ENDAC," already is a parent in ",ENPL_ENDAP_","
End DoDot:2
QUIT
+19 ; save component
+20 SET @(ENRT_ENPL_ENDAP_","_ENDAC_")")=""
SET ENC=ENC+1
+21 ; see if previous maximum depth exceeded
+22 SET Y=$LENGTH(ENPL_ENDAP_","_ENDAC,",")
IF Y>ENMD
SET ENMD=Y
+23 ; if component has components then get them also
+24 IF $ORDER(^ENG(6914,"AE",ENDAC,0))
DO GETC(ENDAC,ENPL_ENDAP_",",ENRT)
End DoDot:1
+25 ; save parent system component count
+26 SET @(ENRT_ENPL_ENDAP_")")=ENC
+27 QUIT
+28 ;ENEQRP6
