ENY2USRD ;(WASH CIOFO)/DH-Y2K Utility System Reports ;8.27.98
;;7.0;ENGINEERING;**55**;August 17,1993
EN W @IOF,!,?20,"UTILITY EQUIPMENT DETAILED REPORT"
I $P($G(^DIC(6910,1,0)),U,2)']"" W !!,"There is no STATION NUMBER in your Engineering Init Paramaters file.",!,"Can't proceed.",*7 Q
S DIR(0)="SM^CAT:Equipment Category;MFGR:Manufacturer Equipment Name",DIR("A")="Select an IDENTIFIER",DIR("B")="CAT"
S DIR("?",1)="The first 15 characters of whichever field you select as your IDENTIFIER"
S DIR("?",2)="will be printed with system components in order to help you know what you're"
S DIR("?")="looking at. Please choose whichever field is likely to be most helpful."
D ^DIR K DIR I $D(DIRUT) G EXIT
S ENIDENT=Y
S ENSTN=0
I $P(^DIC(6910,1,0),U,10)!($D(^DIC(6910,1,3))) D I ENSTN="^" K ENIDENT Q
. W !! S DIR(0)="Y",DIR("A")="Do you want a breakout by station",DIR("B")="NO"
. S DIR("?",1)="If you say 'NO' you will obtain a single report for all your equipment,"
. S DIR("?")="regardless of which station it belongs to."
. D ^DIR K DIR I $D(DIRUT) S ENSTN="^" Q
. S ENSTN=Y
W !! K IO("Q") S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTRTN="DET^ENY2USRD" D G EXIT
. S ZTDESC="Detailed Util Systems Report",ZTIO=ION
. S ZTSAVE("ENIDENT")="",ZTSAVE("ENSTN")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
;
DET ; detailed report of utility system status
; first collect all top level components in ^TMP($J,STATION,IEN)
; then add children IENs as additional subscripts
K ^TMP($J)
N STATION,TYPE,DA,UTIL,NDX,FMLY,X,J
S STATION("PARNT")=$P(^DIC(6910,1,0),U,2),STATION=STATION("PARNT")
S J=0 F S J=$O(^ENG(6918.1,J)) Q:'J S UTIL(J)=$P(^ENG(6918.1,J,0),U)
S DA=0 F S DA=$O(^ENG(6914,"AR","BSE",DA)) Q:'DA I $D(^ENG(6914,DA,0)) D
. I '$D(ZTQUEUED),'(DA#100) W "." ; activity indicator
. Q:$P(^ENG(6914,DA,0),U,3) ; don't count children
. Q:"^4^5^"[(U_$P($G(^ENG(6914,DA,3)),U)_U) ; ck for turn-ins
. I ENSTN S STATION=$S($P($G(^ENG(6914,DA,9)),U,5)]"":$P(^(9),U,5),1:STATION("PARNT"))
. S FMLY="AAA",X=$P($G(^ENG(6914,DA,9)),U,12) I X,$D(UTIL(X)) S FMLY=UTIL(X)
. S ^TMP($J,STATION,FMLY,DA)=""
; now round up the children
S STATION="" F S STATION=$O(^TMP($J,STATION)) Q:STATION="" S FMLY="" F S FMLY=$O(^TMP($J,STATION,FMLY)) Q:FMLY="" S DA=0 F S DA=$O(^TMP($J,STATION,FMLY,DA)) Q:'DA D
. I '$D(^ENG(6914,"AE",DA)) Q ; simple system
. D GETCHLD(DA,"") ; complex system
;
DETPRNT ; print detailed utility system hierarchy
U IO
N PAGE,DATE,ESCAPE,NODE,Y2K,UL,ULD
D NOW^%DTC S Y=% X ^DD("DD") S DATE("PRNT")=$P(Y,":",1,2),PAGE=0
S $P(UL,"-",79)="-",$P(ULD,"=",79)="="
S STATION=""
F S STATION=$O(^TMP($J,STATION)) Q:STATION="" D:PAGE HOLD D HDRDET S FMLY="" F S FMLY=$O(^TMP($J,STATION,FMLY)) Q:FMLY="" S DA=0 D
. F S DA=$O(^TMP($J,STATION,FMLY,DA)) Q:'DA Q:$G(ESCAPE) S Y2K=1 D
.. I STATION?.N S NODE="^TMP("_$J_","_STATION_","""_FMLY_""","_DA_")"
.. E S NODE="^TMP("_$J_","""_STATION_""","""_FMLY_""","_DA_")"
.. F D Q:$QS(NODE,1)'=$J Q:$QS(NODE,4)'=DA Q:$G(ESCAPE)
... I (IOSL-$Y)'>5 D HOLD Q:$G(ESCAPE) D HDRDET
... N IDENT,SYSTEM,LEVEL,COMP
... S IDENT="" I ENIDENT="CAT" S IDENT(0)=$P($G(^ENG(6914,DA,1)),U) I IDENT(0) S IDENT=$E($P($G(^ENG(6911,IDENT(0),0)),U),1,15)
... I ENIDENT="MFGR" S IDENT=$E($P(^ENG(6914,DA,0),U,2),1,15)
... I $QL(NODE)=4 D Q ; top level
.... W !!!,DA,?12,IDENT
.... I @NODE W " ("_@NODE_" comp.)"
.... S Y2K(DA)=$S($P($G(^ENG(6914,DA,11)),U)]"":$P(^(11),U),1:"Null") W " Y2K: ",Y2K(DA) I "^FC^NA^"'[(U_Y2K(DA)_U) S Y2K=0
.... W ?60,$S(FMLY'="AAA":FMLY,1:"NONE")
.... S NODE=$Q(@NODE) I NODE]"",$QS(NODE,1)=$J,$QL(NODE)=4 W !!,"This Utility Component is " W:'Y2K "NOT " W "Y2K Compliant.",!,UL Q
.... I NODE]"",$QS(NODE,1)'=$J W !!,"This Utility Component is " W:'Y2K "NOT " W "Y2K compliant.",!,UL Q
.... I NODE="" W !!,"This Utility Component is " W:'Y2K "NOT " W "Y2K compliant.",!,UL
... F D S NODE=$Q(@NODE) Q:NODE="" Q:$QS(NODE,1)'=$J Q:$QS(NODE,4)'=DA Q:$G(ESCAPE)
.... S LEVEL=$QL(NODE),DA(LEVEL)=$QS(NODE,LEVEL)
.... S IDENT="" I ENIDENT="CAT" S IDENT(0)=$P($G(^ENG(6914,DA(LEVEL),1)),U) I IDENT(0) S IDENT=$E($P($G(^ENG(6911,IDENT(0),0)),U),1,15)
.... I ENIDENT="MFGR" S IDENT=$E($P(^ENG(6914,DA(LEVEL),0),U,2),1,15)
.... S Y2K(DA(LEVEL))=$S($P($G(^ENG(6914,DA(LEVEL),11)),U)]"":$P(^(11),U),1:"Null") I "^FC^NA^"'[(U_Y2K(DA(LEVEL))_U) S Y2K=0
.... W !,?((LEVEL-3)*12),DA(LEVEL),?((LEVEL-2)*12),IDENT
.... I @NODE>0 W " ("_@NODE_" comp.)"
.... W " Y2K: ",Y2K(DA(LEVEL))
.... I (IOSL-$Y)'>5 D HOLD Q:$G(ESCAPE) D HDRDET
... Q:$G(ESCAPE) W !!,"This Utility System is " W:'Y2K "NOT " W "Y2K compliant.",!,UL Q:NODE="" Q:$QS(NODE,1)'=$J Q:$QS(NODE,2)'=STATION
D HOLD G EXIT ; design exit for detailed report
;
HDRDET ; header for detailed utility systems report
Q:$G(ESCAPE)
W:PAGE>0!($E(IOST,1,2)="C-") @IOF S PAGE=PAGE+1
W "Detailed Report of Utility Systems as of "_DATE("PRNT"),?70,"Page: "_PAGE
W !,$S(ENSTN:"Station: "_STATION,1:"Consolidated ("_STATION("PARNT")_")")
W !,"System Entry Number",?60,"System Family"
W !,ULD
Q
;
HOLD Q:$E(IOST,1,2)'="C-"!($G(ESCAPE))
W !!,"Press <RETURN> to continue, '^' to escape..." R X:DTIME
I '$T!($E(X)="^") S ESCAPE=1
Q
;
GETCHLD(PARNT,PRECRSR) ; Get All Components Under Parent System PARNT
;Input
; PARNT - ien of parent system (e.g. 1024)
; PRECRSR - ien list of parent system precursors (e.g.: 150,7019)
;Output
; ^TMP($J,STATION,FMLY,parent ien)=# of components
; ^TMP($J,STATION,FMLY,parent ien,component ien,sub-component ien...)=""
N CHILD,COUNT
; init component counter
S COUNT=0
; loop thru components of parent system PARNT
S CHILD=0 F S CHILD=$O(^ENG(6914,"AE",PARNT,CHILD)) Q:'CHILD D
. ; check for endless loop
. I ","_PRECRSR_PARNT_","[(","_CHILD_",") D Q
. . W !,"ERROR - ENDLESS LOOP DETECTED - SKIPPING ENTRY"
. . W !," Entry #",CHILD," already is a parent in "_PARNT_","
. Q:"^4^5^"[(U_$P($G(^ENG(6914,CHILD,3)),U)_U) ; ck for turn-ins
. ; save component
. S @("^TMP($J,STATION,FMLY,"_PRECRSR_PARNT_","_CHILD_")")="",COUNT=COUNT+1
. ; if component has components then get them also
. I $O(^ENG(6914,"AE",CHILD,0)) D GETCHLD(CHILD,PRECRSR_PARNT_",")
; save parent system component count
S @("^TMP($J,STATION,FMLY,"_PRECRSR_PARNT_")")=COUNT
Q
;
EXIT K ENSTN,ENIDENT
K ^TMP($J)
I $D(ZTQUEUED) S ZTREQN="@"
D ^%ZISC,HOME^%ZIS
Q
;ENY2USRD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2USRD 6502 printed Oct 16, 2024@17:58:24 Page 2
ENY2USRD ;(WASH CIOFO)/DH-Y2K Utility System Reports ;8.27.98
+1 ;;7.0;ENGINEERING;**55**;August 17,1993
EN WRITE @IOF,!,?20,"UTILITY EQUIPMENT DETAILED REPORT"
+1 IF $PIECE($GET(^DIC(6910,1,0)),U,2)']""
WRITE !!,"There is no STATION NUMBER in your Engineering Init Paramaters file.",!,"Can't proceed.",*7
QUIT
+2 SET DIR(0)="SM^CAT:Equipment Category;MFGR:Manufacturer Equipment Name"
SET DIR("A")="Select an IDENTIFIER"
SET DIR("B")="CAT"
+3 SET DIR("?",1)="The first 15 characters of whichever field you select as your IDENTIFIER"
+4 SET DIR("?",2)="will be printed with system components in order to help you know what you're"
+5 SET DIR("?")="looking at. Please choose whichever field is likely to be most helpful."
+6 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO EXIT
+7 SET ENIDENT=Y
+8 SET ENSTN=0
+9 IF $PIECE(^DIC(6910,1,0),U,10)!($DATA(^DIC(6910,1,3)))
Begin DoDot:1
+10 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want a breakout by station"
SET DIR("B")="NO"
+11 SET DIR("?",1)="If you say 'NO' you will obtain a single report for all your equipment,"
+12 SET DIR("?")="regardless of which station it belongs to."
+13 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ENSTN="^"
QUIT
+14 SET ENSTN=Y
End DoDot:1
IF ENSTN="^"
KILL ENIDENT
QUIT
+15 WRITE !!
KILL IO("Q")
SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+16 IF $DATA(IO("Q"))
SET ZTRTN="DET^ENY2USRD"
Begin DoDot:1
+17 SET ZTDESC="Detailed Util Systems Report"
SET ZTIO=ION
+18 SET ZTSAVE("ENIDENT")=""
SET ZTSAVE("ENSTN")=""
+19 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+20 ;
DET ; detailed report of utility system status
+1 ; first collect all top level components in ^TMP($J,STATION,IEN)
+2 ; then add children IENs as additional subscripts
+3 KILL ^TMP($JOB)
+4 NEW STATION,TYPE,DA,UTIL,NDX,FMLY,X,J
+5 SET STATION("PARNT")=$PIECE(^DIC(6910,1,0),U,2)
SET STATION=STATION("PARNT")
+6 SET J=0
FOR
SET J=$ORDER(^ENG(6918.1,J))
if 'J
QUIT
SET UTIL(J)=$PIECE(^ENG(6918.1,J,0),U)
+7 SET DA=0
FOR
SET DA=$ORDER(^ENG(6914,"AR","BSE",DA))
if 'DA
QUIT
IF $DATA(^ENG(6914,DA,0))
Begin DoDot:1
+8 ; activity indicator
IF '$DATA(ZTQUEUED)
IF '(DA#100)
WRITE "."
+9 ; don't count children
if $PIECE(^ENG(6914,DA,0),U,3)
QUIT
+10 ; ck for turn-ins
if "^4^5^"[(U_$PIECE($GET(^ENG(6914,DA,3)),U)_U)
QUIT
+11 IF ENSTN
SET STATION=$SELECT($PIECE($GET(^ENG(6914,DA,9)),U,5)]"":$PIECE(^(9),U,5),1:STATION("PARNT"))
+12 SET FMLY="AAA"
SET X=$PIECE($GET(^ENG(6914,DA,9)),U,12)
IF X
IF $DATA(UTIL(X))
SET FMLY=UTIL(X)
+13 SET ^TMP($JOB,STATION,FMLY,DA)=""
End DoDot:1
+14 ; now round up the children
+15 SET STATION=""
FOR
SET STATION=$ORDER(^TMP($JOB,STATION))
if STATION=""
QUIT
SET FMLY=""
FOR
SET FMLY=$ORDER(^TMP($JOB,STATION,FMLY))
if FMLY=""
QUIT
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,STATION,FMLY,DA))
if 'DA
QUIT
Begin DoDot:1
+16 ; simple system
IF '$DATA(^ENG(6914,"AE",DA))
QUIT
+17 ; complex system
DO GETCHLD(DA,"")
End DoDot:1
+18 ;
DETPRNT ; print detailed utility system hierarchy
+1 USE IO
+2 NEW PAGE,DATE,ESCAPE,NODE,Y2K,UL,ULD
+3 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET DATE("PRNT")=$PIECE(Y,":",1,2)
SET PAGE=0
+4 SET $PIECE(UL,"-",79)="-"
SET $PIECE(ULD,"=",79)="="
+5 SET STATION=""
+6 FOR
SET STATION=$ORDER(^TMP($JOB,STATION))
if STATION=""
QUIT
if PAGE
DO HOLD
DO HDRDET
SET FMLY=""
FOR
SET FMLY=$ORDER(^TMP($JOB,STATION,FMLY))
if FMLY=""
QUIT
SET DA=0
Begin DoDot:1
+7 FOR
SET DA=$ORDER(^TMP($JOB,STATION,FMLY,DA))
if 'DA
QUIT
if $GET(ESCAPE)
QUIT
SET Y2K=1
Begin DoDot:2
+8 IF STATION?.N
SET NODE="^TMP("_$JOB_","_STATION_","""_FMLY_""","_DA_")"
+9 IF '$TEST
SET NODE="^TMP("_$JOB_","""_STATION_""","""_FMLY_""","_DA_")"
+10 FOR
Begin DoDot:3
+11 IF (IOSL-$Y)'>5
DO HOLD
if $GET(ESCAPE)
QUIT
DO HDRDET
+12 NEW IDENT,SYSTEM,LEVEL,COMP
+13 SET IDENT=""
IF ENIDENT="CAT"
SET IDENT(0)=$PIECE($GET(^ENG(6914,DA,1)),U)
IF IDENT(0)
SET IDENT=$EXTRACT($PIECE($GET(^ENG(6911,IDENT(0),0)),U),1,15)
+14 IF ENIDENT="MFGR"
SET IDENT=$EXTRACT($PIECE(^ENG(6914,DA,0),U,2),1,15)
+15 ; top level
IF $QLENGTH(NODE)=4
Begin DoDot:4
+16 WRITE !!!,DA,?12,IDENT
+17 IF @NODE
WRITE " ("_@NODE_" comp.)"
+18 SET Y2K(DA)=$SELECT($PIECE($GET(^ENG(6914,DA,11)),U)]"":$PIECE(^(11),U),1:"Null")
WRITE " Y2K: ",Y2K(DA)
IF "^FC^NA^"'[(U_Y2K(DA)_U)
SET Y2K=0
+19 WRITE ?60,$SELECT(FMLY'="AAA":FMLY,1:"NONE")
+20 SET NODE=$QUERY(@NODE)
IF NODE]""
IF $QSUBSCRIPT(NODE,1)=$JOB
IF $QLENGTH(NODE)=4
WRITE !!,"This Utility Component is "
if 'Y2K
WRITE "NOT "
WRITE "Y2K Compliant.",!,UL
QUIT
+21 IF NODE]""
IF $QSUBSCRIPT(NODE,1)'=$JOB
WRITE !!,"This Utility Component is "
if 'Y2K
WRITE "NOT "
WRITE "Y2K compliant.",!,UL
QUIT
+22 IF NODE=""
WRITE !!,"This Utility Component is "
if 'Y2K
WRITE "NOT "
WRITE "Y2K compliant.",!,UL
End DoDot:4
QUIT
+23 FOR
Begin DoDot:4
+24 SET LEVEL=$QLENGTH(NODE)
SET DA(LEVEL)=$QSUBSCRIPT(NODE,LEVEL)
+25 SET IDENT=""
IF ENIDENT="CAT"
SET IDENT(0)=$PIECE($GET(^ENG(6914,DA(LEVEL),1)),U)
IF IDENT(0)
SET IDENT=$EXTRACT($PIECE($GET(^ENG(6911,IDENT(0),0)),U),1,15)
+26 IF ENIDENT="MFGR"
SET IDENT=$EXTRACT($PIECE(^ENG(6914,DA(LEVEL),0),U,2),1,15)
+27 SET Y2K(DA(LEVEL))=$SELECT($PIECE($GET(^ENG(6914,DA(LEVEL),11)),U)]"":$PIECE(^(11),U),1:"Null")
IF "^FC^NA^"'[(U_Y2K(DA(LEVEL))_U)
SET Y2K=0
+28 WRITE !,?((LEVEL-3)*12),DA(LEVEL),?((LEVEL-2)*12),IDENT
+29 IF @NODE>0
WRITE " ("_@NODE_" comp.)"
+30 WRITE " Y2K: ",Y2K(DA(LEVEL))
+31 IF (IOSL-$Y)'>5
DO HOLD
if $GET(ESCAPE)
QUIT
DO HDRDET
End DoDot:4
SET NODE=$QUERY(@NODE)
if NODE=""
QUIT
if $QSUBSCRIPT(NODE,1)'=$JOB
QUIT
if $QSUBSCRIPT(NODE,4)'=DA
QUIT
if $GET(ESCAPE)
QUIT
+32 if $GET(ESCAPE)
QUIT
WRITE !!,"This Utility System is "
if 'Y2K
WRITE "NOT "
WRITE "Y2K compliant.",!,UL
if NODE=""
QUIT
if $QSUBSCRIPT(NODE,1)'=$JOB
QUIT
if $QSUBSCRIPT(NODE,2)'=STATION
QUIT
End DoDot:3
if $QSUBSCRIPT(NODE,1)'=$JOB
QUIT
if $QSUBSCRIPT(NODE,4)'=DA
QUIT
if $GET(ESCAPE)
QUIT
End DoDot:2
End DoDot:1
+33 ; design exit for detailed report
DO HOLD
GOTO EXIT
+34 ;
HDRDET ; header for detailed utility systems report
+1 if $GET(ESCAPE)
QUIT
+2 if PAGE>0!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
SET PAGE=PAGE+1
+3 WRITE "Detailed Report of Utility Systems as of "_DATE("PRNT"),?70,"Page: "_PAGE
+4 WRITE !,$SELECT(ENSTN:"Station: "_STATION,1:"Consolidated ("_STATION("PARNT")_")")
+5 WRITE !,"System Entry Number",?60,"System Family"
+6 WRITE !,ULD
+7 QUIT
+8 ;
HOLD if $EXTRACT(IOST,1,2)'="C-"!($GET(ESCAPE))
QUIT
+1 WRITE !!,"Press <RETURN> to continue, '^' to escape..."
READ X:DTIME
+2 IF '$TEST!($EXTRACT(X)="^")
SET ESCAPE=1
+3 QUIT
+4 ;
GETCHLD(PARNT,PRECRSR) ; Get All Components Under Parent System PARNT
+1 ;Input
+2 ; PARNT - ien of parent system (e.g. 1024)
+3 ; PRECRSR - ien list of parent system precursors (e.g.: 150,7019)
+4 ;Output
+5 ; ^TMP($J,STATION,FMLY,parent ien)=# of components
+6 ; ^TMP($J,STATION,FMLY,parent ien,component ien,sub-component ien...)=""
+7 NEW CHILD,COUNT
+8 ; init component counter
+9 SET COUNT=0
+10 ; loop thru components of parent system PARNT
+11 SET CHILD=0
FOR
SET CHILD=$ORDER(^ENG(6914,"AE",PARNT,CHILD))
if 'CHILD
QUIT
Begin DoDot:1
+12 ; check for endless loop
+13 IF ","_PRECRSR_PARNT_","[(","_CHILD_",")
Begin DoDot:2
+14 WRITE !,"ERROR - ENDLESS LOOP DETECTED - SKIPPING ENTRY"
+15 WRITE !," Entry #",CHILD," already is a parent in "_PARNT_","
End DoDot:2
QUIT
+16 ; ck for turn-ins
if "^4^5^"[(U_$PIECE($GET(^ENG(6914,CHILD,3)),U)_U)
QUIT
+17 ; save component
+18 SET @("^TMP($J,STATION,FMLY,"_PRECRSR_PARNT_","_CHILD_")")=""
SET COUNT=COUNT+1
+19 ; if component has components then get them also
+20 IF $ORDER(^ENG(6914,"AE",CHILD,0))
DO GETCHLD(CHILD,PRECRSR_PARNT_",")
End DoDot:1
+21 ; save parent system component count
+22 SET @("^TMP($J,STATION,FMLY,"_PRECRSR_PARNT_")")=COUNT
+23 QUIT
+24 ;
EXIT KILL ENSTN,ENIDENT
+1 KILL ^TMP($JOB)
+2 IF $DATA(ZTQUEUED)
SET ZTREQN="@"
+3 DO ^%ZISC
DO HOME^%ZIS
+4 QUIT
+5 ;ENY2USRD
