ENY2REP9 ;(WIRMFO)/DH-Y2K Equipment w/o Y2K Category ;8.18.98
;;7.0;ENGINEERING;**51,55**;August 17, 1993
NULL ; prints list of equipment with man and mod but no Y2K category
W @IOF,!!,?17,"List of Active Equipment Records with MANUFACTURER"
W !,?23,"and MODEL, but without a Y2K CATEGORY"
N COUNT
S COUNT("EQ")=$P(^ENG(6914,0),U,4),COUNT("Y2K")=$P($G(^ENG(6918,0)),U,4) S:COUNT("Y2K")="" COUNT("Y2K")=0
I COUNT("Y2K")/COUNT("EQ")'>.5 D Q:'Y
. W !!,"From glancing at your data base, it appears that less than half of your",!,"equipment records have a Y2K CATEGORY of any kind on file."
. W !!,"Are you sure this report is worth printing?",*7
. S DIR(0)="Y",DIR("B")="NO"
. D ^DIR K DIR S:$D(DIRUT) Y=0
W ! K IO("Q") S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) S ZTRTN="LIST^ENY2REP9" D Q
. S ZTION=ION,ZTDESC="Y2K Null Item List"
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
;
LIST ;
N DA,EN,MFG,MOD,LID,EC,SRVC,LOC,SN,DATE,PAGE,ESCAPE
K ^TMP($J)
S DA=0 F S DA=$O(^ENG(6914,DA)) Q:'DA I $D(^ENG(6914,DA,0)),$P($G(^(11)),U)="" D
. I '$D(ZTQUEUED),'(DA#100) W "." ; activity indicator
. S EN(1)=$G(^ENG(6914,DA,1)),MFG(0)=$P(EN(1),U,4)
. Q:MFG(0)'>0 Q:'$D(^ENG("MFG",MFG(0),0)) S MFG=$E($P(^ENG("MFG",MFG(0),0),U),1,35)
. S MOD=$P(EN(1),U,2) Q:MOD']"" S MOD=$P(EN(1),U,2)
. S EC(0)=$P(EN(1),U),SN=$P(EN(1),U,3)
. S EN(3)=$G(^ENG(6914,DA,3)) Q:"^4^5^"[(U_$P(EN(3),U)_U) ; turn-ins
. S SRVC(0)=$P(EN(3),U,2),LOC(0)=$P(EN(3),U,5),LID=$P(EN(3),U,7)
. S ^TMP($J,MFG,MOD,DA)=LID_U_EC(0)_U_SRVC(0)_U_LOC(0)_U_SN
;
PRT ; physical print
U IO
D NOW^%DTC S Y=% X ^DD("DD") S DATE("PRNT")=$P(Y,":",1,2),PAGE=0
D HDR I '$D(^TMP($J)) W !!!,?20,"<Nothing to print>" G EXIT
S MFG="" F Q:$G(ESCAPE) S MFG=$O(^TMP($J,MFG)) Q:MFG="" S MOD="" F Q:$G(ESCAPE) S MOD=$O(^TMP($J,MFG,MOD)) Q:MOD="" S DA=0 F S DA=$O(^TMP($J,MFG,MOD,DA)) Q:'DA!($G(ESCAPE)) D
. I '$D(ZTQUEUED),IO'=IO(0),'(DA#100) U IO(0) W "." U IO ; activity indicator
. S EN=^TMP($J,MFG,MOD,DA),LID=$P(EN,U),EC(0)=$P(EN,U,2),SRVC(0)=$P(EN,U,3),LOC(0)=$P(EN,U,4),SN=$P(EN,U,5)
. I EC(0)'>0 S EC=""
. E S EC=$S($D(^ENG(6911,EC(0),0)):$P(^(0),U),1:"")
. I SRVC(0)'>0 S SRVC=""
. E S SRVC=$S($D(^DIC(49,SRVC(0),0)):$P(^(0),U),1:"")
. I LOC(0)'?1.N S LOC=LOC(0)
. E S LOC=$S($D(^ENG("SP",LOC(0),0)):$P(^(0),U),1:"")
. I IOM<96 D Q
.. W !!,DA,?10,$E(MFG,1,30),?41,$E(MOD,1,20),?62,LID
.. W !,$E(EC,1,22),?23,$E(SRVC,1,20),?44,$E(LOC,1,15),?60,$E(SN,1,20)
.. I (IOSL-$Y)'>4 D HOLD D:'$G(ESCAPE) HDR
. W !!,DA,?11,MFG,?46,MOD,?76,LID
. W !,$E(EC,1,22),?23,$E(SRVC,1,20),?44,LOC,?65,$E(SN,1,30)
. I (IOSL-$Y)'>4 D HOLD D:'$G(ESCAPE) HDR
G EXIT
;
HDR ; header print
W:$E(IOST,1,2)="C-"!(PAGE) @IOF S PAGE=PAGE+1
I IOM<96 D Q
. W "Null Equipment List (MAN & MODEL but no Y2K) "_DATE("PRNT")_" Page: "_PAGE
. W !,"ENTRY #",?15,"MANUFACTURER",?48,"MODEL",?64,"LOCAL ID"
. W !,"EQUIPMENT CATEGORY",?25,"SERVICE",?45,"LOCATION",?62,"SERIAL NUMBER"
. K X S $P(X,"-",79)="-" W !,X
W "Null Equipment List (MANUFACTURER & MODEL, but no Y2K CATEGORY) "_DATE("PRNT")_" Page: "_PAGE
W !,"ENTRY #",?18,"MANUFACTURER",?54,"MODEL",?78,"LOCAL ID"
W !,"EQUIPMENT CATEGORY",?26,"SERVICE",?47,"LOCATION",?68,"SERIAL NUMBER"
K X S $P(X,"-",95)="-" W !,X
Q
;
HOLD I $E(IOST,1,2)="C-" W !!,"Press <RETURN> to continue, '^' to escape..." R X:DTIME I '$T!($E(X)="^") S ESCAPE=1
Q
;
EXIT ;
K ^TMP($J)
D ^%ZISC,HOME^%ZIS
I $D(ZTQUEUED) S ZTREQN="@"
Q
;ENY2REP9
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2REP9 3520 printed Dec 13, 2024@01:57:32 Page 2
ENY2REP9 ;(WIRMFO)/DH-Y2K Equipment w/o Y2K Category ;8.18.98
+1 ;;7.0;ENGINEERING;**51,55**;August 17, 1993
NULL ; prints list of equipment with man and mod but no Y2K category
+1 WRITE @IOF,!!,?17,"List of Active Equipment Records with MANUFACTURER"
+2 WRITE !,?23,"and MODEL, but without a Y2K CATEGORY"
+3 NEW COUNT
+4 SET COUNT("EQ")=$PIECE(^ENG(6914,0),U,4)
SET COUNT("Y2K")=$PIECE($GET(^ENG(6918,0)),U,4)
if COUNT("Y2K")=""
SET COUNT("Y2K")=0
+5 IF COUNT("Y2K")/COUNT("EQ")'>.5
Begin DoDot:1
+6 WRITE !!,"From glancing at your data base, it appears that less than half of your",!,"equipment records have a Y2K CATEGORY of any kind on file."
+7 WRITE !!,"Are you sure this report is worth printing?",*7
+8 SET DIR(0)="Y"
SET DIR("B")="NO"
+9 DO ^DIR
KILL DIR
if $DATA(DIRUT)
SET Y=0
End DoDot:1
if 'Y
QUIT
+10 WRITE !
KILL IO("Q")
SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+11 IF $DATA(IO("Q"))
SET ZTRTN="LIST^ENY2REP9"
Begin DoDot:1
+12 SET ZTION=ION
SET ZTDESC="Y2K Null Item List"
+13 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
QUIT
+14 ;
LIST ;
+1 NEW DA,EN,MFG,MOD,LID,EC,SRVC,LOC,SN,DATE,PAGE,ESCAPE
+2 KILL ^TMP($JOB)
+3 SET DA=0
FOR
SET DA=$ORDER(^ENG(6914,DA))
if 'DA
QUIT
IF $DATA(^ENG(6914,DA,0))
IF $PIECE($GET(^(11)),U)=""
Begin DoDot:1
+4 ; activity indicator
IF '$DATA(ZTQUEUED)
IF '(DA#100)
WRITE "."
+5 SET EN(1)=$GET(^ENG(6914,DA,1))
SET MFG(0)=$PIECE(EN(1),U,4)
+6 if MFG(0)'>0
QUIT
if '$DATA(^ENG("MFG",MFG(0),0))
QUIT
SET MFG=$EXTRACT($PIECE(^ENG("MFG",MFG(0),0),U),1,35)
+7 SET MOD=$PIECE(EN(1),U,2)
if MOD']""
QUIT
SET MOD=$PIECE(EN(1),U,2)
+8 SET EC(0)=$PIECE(EN(1),U)
SET SN=$PIECE(EN(1),U,3)
+9 ; turn-ins
SET EN(3)=$GET(^ENG(6914,DA,3))
if "^4^5^"[(U_$PIECE(EN(3),U)_U)
QUIT
+10 SET SRVC(0)=$PIECE(EN(3),U,2)
SET LOC(0)=$PIECE(EN(3),U,5)
SET LID=$PIECE(EN(3),U,7)
+11 SET ^TMP($JOB,MFG,MOD,DA)=LID_U_EC(0)_U_SRVC(0)_U_LOC(0)_U_SN
End DoDot:1
+12 ;
PRT ; physical print
+1 USE IO
+2 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET DATE("PRNT")=$PIECE(Y,":",1,2)
SET PAGE=0
+3 DO HDR
IF '$DATA(^TMP($JOB))
WRITE !!!,?20,"<Nothing to print>"
GOTO EXIT
+4 SET MFG=""
FOR
if $GET(ESCAPE)
QUIT
SET MFG=$ORDER(^TMP($JOB,MFG))
if MFG=""
QUIT
SET MOD=""
FOR
if $GET(ESCAPE)
QUIT
SET MOD=$ORDER(^TMP($JOB,MFG,MOD))
if MOD=""
QUIT
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,MFG,MOD,DA))
if 'DA!($GET(ESCAPE))
QUIT
Begin DoDot:1
+5 ; activity indicator
IF '$DATA(ZTQUEUED)
IF IO'=IO(0)
IF '(DA#100)
USE IO(0)
WRITE "."
USE IO
+6 SET EN=^TMP($JOB,MFG,MOD,DA)
SET LID=$PIECE(EN,U)
SET EC(0)=$PIECE(EN,U,2)
SET SRVC(0)=$PIECE(EN,U,3)
SET LOC(0)=$PIECE(EN,U,4)
SET SN=$PIECE(EN,U,5)
+7 IF EC(0)'>0
SET EC=""
+8 IF '$TEST
SET EC=$SELECT($DATA(^ENG(6911,EC(0),0)):$PIECE(^(0),U),1:"")
+9 IF SRVC(0)'>0
SET SRVC=""
+10 IF '$TEST
SET SRVC=$SELECT($DATA(^DIC(49,SRVC(0),0)):$PIECE(^(0),U),1:"")
+11 IF LOC(0)'?1.N
SET LOC=LOC(0)
+12 IF '$TEST
SET LOC=$SELECT($DATA(^ENG("SP",LOC(0),0)):$PIECE(^(0),U),1:"")
+13 IF IOM<96
Begin DoDot:2
+14 WRITE !!,DA,?10,$EXTRACT(MFG,1,30),?41,$EXTRACT(MOD,1,20),?62,LID
+15 WRITE !,$EXTRACT(EC,1,22),?23,$EXTRACT(SRVC,1,20),?44,$EXTRACT(LOC,1,15),?60,$EXTRACT(SN,1,20)
+16 IF (IOSL-$Y)'>4
DO HOLD
if '$GET(ESCAPE)
DO HDR
End DoDot:2
QUIT
+17 WRITE !!,DA,?11,MFG,?46,MOD,?76,LID
+18 WRITE !,$EXTRACT(EC,1,22),?23,$EXTRACT(SRVC,1,20),?44,LOC,?65,$EXTRACT(SN,1,30)
+19 IF (IOSL-$Y)'>4
DO HOLD
if '$GET(ESCAPE)
DO HDR
End DoDot:1
+20 GOTO EXIT
+21 ;
HDR ; header print
+1 if $EXTRACT(IOST,1,2)="C-"!(PAGE)
WRITE @IOF
SET PAGE=PAGE+1
+2 IF IOM<96
Begin DoDot:1
+3 WRITE "Null Equipment List (MAN & MODEL but no Y2K) "_DATE("PRNT")_" Page: "_PAGE
+4 WRITE !,"ENTRY #",?15,"MANUFACTURER",?48,"MODEL",?64,"LOCAL ID"
+5 WRITE !,"EQUIPMENT CATEGORY",?25,"SERVICE",?45,"LOCATION",?62,"SERIAL NUMBER"
+6 KILL X
SET $PIECE(X,"-",79)="-"
WRITE !,X
End DoDot:1
QUIT
+7 WRITE "Null Equipment List (MANUFACTURER & MODEL, but no Y2K CATEGORY) "_DATE("PRNT")_" Page: "_PAGE
+8 WRITE !,"ENTRY #",?18,"MANUFACTURER",?54,"MODEL",?78,"LOCAL ID"
+9 WRITE !,"EQUIPMENT CATEGORY",?26,"SERVICE",?47,"LOCATION",?68,"SERIAL NUMBER"
+10 KILL X
SET $PIECE(X,"-",95)="-"
WRITE !,X
+11 QUIT
+12 ;
HOLD IF $EXTRACT(IOST,1,2)="C-"
WRITE !!,"Press <RETURN> to continue, '^' to escape..."
READ X:DTIME
IF '$TEST!($EXTRACT(X)="^")
SET ESCAPE=1
+1 QUIT
+2 ;
EXIT ;
+1 KILL ^TMP($JOB)
+2 DO ^%ZISC
DO HOME^%ZIS
+3 IF $DATA(ZTQUEUED)
SET ZTREQN="@"
+4 QUIT
+5 ;ENY2REP9
