- 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 Mar 13, 2025@20:57:46 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
