- 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 Mar 13, 2025@21:02:16 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
