ENY2REPC ;;(WIRMFO)/DH-Y2K Detail by Man~Mod ;1.19.99
;;7.0;ENGINEERING;**61**;August 17, 1993
;
DEQDET ;
I $D(ZTQUEUED) D
. K ^TMP($J)
. S %X="^XUTL(""ENY2"",DATE,",%Y="^TMP($J," D %XY^%RCR K DATE
. N ESCAPE,ENY2K,DATE,MFG
. K ^XUTL("ENY2")
N MOD,PAGE,DATE,LINE,TOTAL,STATION
S PAGE=0 D NOW^%DTC S Y=% X ^DD("DD") S DATE("PRNT")=$P(Y,":",1,2)
S STATION("PARNT")=$P($G(^DIC(6910,1,0)),U,2)
S STATION=STATION("PARNT")
F J="COUNT","ACT","EST" S TOTAL(J)=0,TOTAL(STATION,J)=0 ; initialize
K ^TMP($J,"ENY2")
S DA=0 F S DA=$O(^TMP($J,DA)) Q:'DA D:$D(^ENG(6914,DA,0))
. I '$D(ZTQUEUED) W:'(DA#100) "." ; activity indicator
. S CAT=$P($G(^ENG(6914,DA,11)),U) S:CAT="" CAT="Null"
. I ENSUP,"^FC^NA^"[(U_CAT_U) Q ; suppress the 'don't cares'
. I ALLSTN S STATION=$S($P($G(^ENG(6914,DA,9)),U,5)]"":$P(^(9),U,5),1:STATION("PARNT")) I '$D(TOTAL(STATION)) S TOTAL(STATION,"GRAND")=0 F J="COUNT","ACT","EST" S TOTAL(STATION,J)=0
. S MFG(0)=$P($G(^ENG(6914,DA,1)),U,4)
. I 'MFG(0),'$G(ENY2K("INC")) Q
. I 'MFG(0) S MFG("E")="unknown"
. E S MFG("E")=$E($P(^ENG("MFG",MFG(0),0),U),1,25) S:MFG("E")="" MFG("E")=" "
. S MOD=$P($G(^ENG(6914,DA,1)),U,2)
. I MOD="",'$G(ENY2K("INC")) Q
. I MOD="" S MOD("E")="unknown"
. E S MOD("E")=$S($L(MOD)<21:MOD,1:$E(MOD,1,19)_"*")
. S EQ(0)=$P($G(^ENG(6914,DA,1)),U) S:EQ(0)="" EQ("E")="Null"
. I EQ(0) S EQ("E")=$E($P($G(^ENG(6911,EQ(0),0)),U),1,20) S:EQ("E")="" EQ("E")="Null"
. F J="EDATE","ADATE","ECOST","ACOST","ACTN" S ENY2K(J)=""
. S EN=$G(^ENG(6914,DA,11)) I EN]"" D
.. S Y=$P(EN,U,2) I Y>0 S ENY2K("EDATE")=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
.. S Y=$P(EN,U,10) I Y>0 S ENY2K("ADATE")=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
.. S ENY2K("ECOST")=$P(($P(EN,U,3)+.5),"."),ENY2K("ACOST")=$P(($P(EN,U,4)+.5),"."),ENY2K("ACTN")=$P(EN,U,6)
. S ^TMP($J,"ENY2",STATION,MFG("E"),MOD("E"),EQ("E"),DA)=CAT_U_ENY2K("EDATE")_U_ENY2K("ADATE")_U_ENY2K("ECOST")_U_ENY2K("ACOST")_U_ENY2K("ACTN")
. S TOTAL(STATION,"COUNT")=TOTAL(STATION,"COUNT")+1,TOTAL(STATION,"EST")=TOTAL(STATION,"EST")+ENY2K("ECOST"),TOTAL(STATION,"ACT")=TOTAL(STATION,"ACT")+ENY2K("ACOST")
I '$D(^TMP($J,"ENY2")) D DETHDR W !!,"<There are no equipment records with outstanding Y2K issues>" Q
S STATION=0 F S STATION=$O(^TMP($J,"ENY2",STATION)) Q:STATION="" S TOTAL("COUNT")=TOTAL("COUNT")+TOTAL(STATION,"COUNT"),TOTAL("EST")=TOTAL("EST")+TOTAL(STATION,"EST"),TOTAL("ACT")=TOTAL("ACT")+TOTAL(STATION,"ACT")
;
DETPRNT ; print the detail
U IO
I '$D(^TMP($J)) D DETHDR W !!,?15,"<Nothing to print>" D HOLD Q
S STATION=0 F S STATION=$O(^TMP($J,"ENY2",STATION)) Q:STATION=""!($G(ESCAPE)) D DETHDR D D HOLD Q:$G(ESCAPE) W @IOF
. S MFG("E")=0,MOD("E")=0 F S MFG("E")=$O(^TMP($J,"ENY2",STATION,MFG("E"))) Q:MFG("E")=""!($G(ESCAPE)) F S MOD("E")=$O(^TMP($J,"ENY2",STATION,MFG("E"),MOD("E"))) Q:MOD("E")=""!($G(ESCAPE)) D Q:$G(ESCAPE)
.. S EQ("E")=0 F S EQ("E")=$O(^TMP($J,"ENY2",STATION,MFG("E"),MOD("E"),EQ("E"))) Q:EQ("E")=""!($G(ESCAPE)) S DA=0 F S DA=$O(^TMP($J,"ENY2",STATION,MFG("E"),MOD("E"),EQ("E"),DA)) Q:'DA!($G(ESCAPE)) S EN=^(DA) D
... I '$D(ZTQUEUED),IO'=IO(0),'(DA#50) U IO(0) W "." U IO ; activity indicator
... W !,MFG("E")_"~"_MOD("E")_" ",?42,EQ("E")_" ",?64,$J(DA,10),?75,$J($P(EN,U),4),?82,$P(EN,U,2),?93,$P(EN,U,3),?104,$J($P(EN,U,4),7),?114,$J($P(EN,U,5),7),?124,$P(EN,U,6)
... K ^TMP($J,"ENY2",STATION,MFG("E"),MOD("E"),EQ("E"),DA)
... S LINE=LINE+1 I (IOSL-LINE)'>6 D TRLR,HOLD Q:$G(ESCAPE) D:$D(^TMP($J,"ENY2")) DETHDR
. Q:$G(ESCAPE) K X S $P(X,"-",130)="-" W !,X
. W !,"COUNT",?64,$J(TOTAL(STATION,"COUNT"),10)
. W !,"TOTALS",?103,"$"_$J(TOTAL(STATION,"EST"),7),?113,"$"_$J(TOTAL(STATION,"ACT"),7) S LINE=LINE+3
. I ALLSTN,'$O(^TMP($J,"ENY2",STATION)) D
.. W !,"COUNT FOR ALL STATIONS",?64,$J(TOTAL("COUNT"),10)
.. W !,"TOTALS FOR ALL STATIONS",?103,"$"_$J(TOTAL("EST"),7),?113,"$"_$J(TOTAL("ACT"),7) S LINE=LINE+2
. F Q:(IOSL-LINE)'>5 W ! S LINE=LINE+1
. D TRLR
Q ;return to ^eny2rep3 for exit
;
DETHDR ; header for Y2K detail
W:$E(IOST,1,2)="C-"!(PAGE) @IOF S PAGE=PAGE+1,LINE=3
W "Detailed Y2K Equipment Report "
W $S(CRITER=1:"by EQUIPMENT CATEGORY",CRITER=2:"by CATEGORY STOCK NUMBER",CRITER=3:"by CMR",CRITER=4:"by SERVICE",CRITER=5:"by MANUFACTURER",CRITER=6:"by LOCAL ID",CRITER=7:"by RESPONSIBLE SHOP",1:"for ENTIRE EQUIP FILE")
W " ("_$E(SORT,1,20)_") "_DATE("PRNT")_" "_$S('ALLSTN:"Consolidated",1:"Station: "_STATION)_" Page: "_PAGE
I ENSUP W !,"Equipment Records with Y2K Category of 'FC' or 'NA' are not being counted." S LINE=LINE+1
W !,"Manufacturer~Model",?45,"Equipment Category",?67,"Entry #",?76,"Y2K Est Date Act Date Est Cost Act Cost Action"
K X S $P(X,"-",130)="-" W !,X
Q
;
TRLR ; print legend at bottom
K X S $P(X,"-",130)="-" W !,X
W !,"Y2K: FC=>Fully Compliant NC=>Noncompliant CC=>Conditionally Compliant NA=>Not Applicable Null=>No Y2K Information"
W !,"ACTION (Noncompliant Only): REP=>Replace RET=>Retire UPD=>Update to Full Compliance USE=>Use Without an Update"
W !
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
;ENY2REPC
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2REPC 5254 printed Dec 13, 2024@01:57:35 Page 2
ENY2REPC ;;(WIRMFO)/DH-Y2K Detail by Man~Mod ;1.19.99
+1 ;;7.0;ENGINEERING;**61**;August 17, 1993
+2 ;
DEQDET ;
+1 IF $DATA(ZTQUEUED)
Begin DoDot:1
+2 KILL ^TMP($JOB)
+3 SET %X="^XUTL(""ENY2"",DATE,"
SET %Y="^TMP($J,"
DO %XY^%RCR
KILL DATE
+4 NEW ESCAPE,ENY2K,DATE,MFG
+5 KILL ^XUTL("ENY2")
End DoDot:1
+6 NEW MOD,PAGE,DATE,LINE,TOTAL,STATION
+7 SET PAGE=0
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET DATE("PRNT")=$PIECE(Y,":",1,2)
+8 SET STATION("PARNT")=$PIECE($GET(^DIC(6910,1,0)),U,2)
+9 SET STATION=STATION("PARNT")
+10 ; initialize
FOR J="COUNT","ACT","EST"
SET TOTAL(J)=0
SET TOTAL(STATION,J)=0
+11 KILL ^TMP($JOB,"ENY2")
+12 SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,DA))
if 'DA
QUIT
if $DATA(^ENG(6914,DA,0))
Begin DoDot:1
+13 ; activity indicator
IF '$DATA(ZTQUEUED)
if '(DA#100)
WRITE "."
+14 SET CAT=$PIECE($GET(^ENG(6914,DA,11)),U)
if CAT=""
SET CAT="Null"
+15 ; suppress the 'don't cares'
IF ENSUP
IF "^FC^NA^"[(U_CAT_U)
QUIT
+16 IF ALLSTN
SET STATION=$SELECT($PIECE($GET(^ENG(6914,DA,9)),U,5)]"":$PIECE(^(9),U,5),1:STATION("PARNT"))
IF '$DATA(TOTAL(STATION))
SET TOTAL(STATION,"GRAND")=0
FOR J="COUNT","ACT","EST"
SET TOTAL(STATION,J)=0
+17 SET MFG(0)=$PIECE($GET(^ENG(6914,DA,1)),U,4)
+18 IF 'MFG(0)
IF '$GET(ENY2K("INC"))
QUIT
+19 IF 'MFG(0)
SET MFG("E")="unknown"
+20 IF '$TEST
SET MFG("E")=$EXTRACT($PIECE(^ENG("MFG",MFG(0),0),U),1,25)
if MFG("E")=""
SET MFG("E")=" "
+21 SET MOD=$PIECE($GET(^ENG(6914,DA,1)),U,2)
+22 IF MOD=""
IF '$GET(ENY2K("INC"))
QUIT
+23 IF MOD=""
SET MOD("E")="unknown"
+24 IF '$TEST
SET MOD("E")=$SELECT($LENGTH(MOD)<21:MOD,1:$EXTRACT(MOD,1,19)_"*")
+25 SET EQ(0)=$PIECE($GET(^ENG(6914,DA,1)),U)
if EQ(0)=""
SET EQ("E")="Null"
+26 IF EQ(0)
SET EQ("E")=$EXTRACT($PIECE($GET(^ENG(6911,EQ(0),0)),U),1,20)
if EQ("E")=""
SET EQ("E")="Null"
+27 FOR J="EDATE","ADATE","ECOST","ACOST","ACTN"
SET ENY2K(J)=""
+28 SET EN=$GET(^ENG(6914,DA,11))
IF EN]""
Begin DoDot:2
+29 SET Y=$PIECE(EN,U,2)
IF Y>0
SET ENY2K("EDATE")=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
+30 SET Y=$PIECE(EN,U,10)
IF Y>0
SET ENY2K("ADATE")=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
+31 SET ENY2K("ECOST")=$PIECE(($PIECE(EN,U,3)+.5),".")
SET ENY2K("ACOST")=$PIECE(($PIECE(EN,U,4)+.5),".")
SET ENY2K("ACTN")=$PIECE(EN,U,6)
End DoDot:2
+32 SET ^TMP($JOB,"ENY2",STATION,MFG("E"),MOD("E"),EQ("E"),DA)=CAT_U_ENY2K("EDATE")_U_ENY2K("ADATE")_U_ENY2K("ECOST")_U_ENY2K("ACOST")_U_ENY2K("ACTN")
+33 SET TOTAL(STATION,"COUNT")=TOTAL(STATION,"COUNT")+1
SET TOTAL(STATION,"EST")=TOTAL(STATION,"EST")+ENY2K("ECOST")
SET TOTAL(STATION,"ACT")=TOTAL(STATION,"ACT")+ENY2K("ACOST")
End DoDot:1
+34 IF '$DATA(^TMP($JOB,"ENY2"))
DO DETHDR
WRITE !!,"<There are no equipment records with outstanding Y2K issues>"
QUIT
+35 SET STATION=0
FOR
SET STATION=$ORDER(^TMP($JOB,"ENY2",STATION))
if STATION=""
QUIT
SET TOTAL("COUNT")=TOTAL("COUNT")+TOTAL(STATION,"COUNT")
SET TOTAL("EST")=TOTAL("EST")+TOTAL(STATION,"EST")
SET TOTAL("ACT")=TOTAL("ACT")+TOTAL(STATION,"ACT")
+36 ;
DETPRNT ; print the detail
+1 USE IO
+2 IF '$DATA(^TMP($JOB))
DO DETHDR
WRITE !!,?15,"<Nothing to print>"
DO HOLD
QUIT
+3 SET STATION=0
FOR
SET STATION=$ORDER(^TMP($JOB,"ENY2",STATION))
if STATION=""!($GET(ESCAPE))
QUIT
DO DETHDR
Begin DoDot:1
+4 SET MFG("E")=0
SET MOD("E")=0
FOR
SET MFG("E")=$ORDER(^TMP($JOB,"ENY2",STATION,MFG("E")))
if MFG("E")=""!($GET(ESCAPE))
QUIT
FOR
SET MOD("E")=$ORDER(^TMP($JOB,"ENY2",STATION,MFG("E"),MOD("E")))
if MOD("E")=""!($GET(ESCAPE))
QUIT
Begin DoDot:2
+5 SET EQ("E")=0
FOR
SET EQ("E")=$ORDER(^TMP($JOB,"ENY2",STATION,MFG("E"),MOD("E"),EQ("E")))
if EQ("E")=""!($GET(ESCAPE))
QUIT
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,"ENY2",STATION,MFG("E"),MOD("E"),EQ("E"),DA))
if 'DA!($GET(ESCAPE))
QUIT
SET EN=^(DA)
Begin DoDot:3
+6 ; activity indicator
IF '$DATA(ZTQUEUED)
IF IO'=IO(0)
IF '(DA#50)
USE IO(0)
WRITE "."
USE IO
+7 WRITE !,MFG("E")_"~"_MOD("E")_" ",?42,EQ("E")_" ",?64,$JUSTIFY(DA,10),?75,$JUSTIFY($PIECE(EN,U),4),?82,$PIECE(EN,U,2),?93,$PIECE(EN,U,3),?104,$JUSTIFY($PIECE(EN,U,4),7),?114,$JUSTIFY($PIECE(EN,U,5),7),?124,$PIECE
(EN,U,6)
+8 KILL ^TMP($JOB,"ENY2",STATION,MFG("E"),MOD("E"),EQ("E"),DA)
+9 SET LINE=LINE+1
IF (IOSL-LINE)'>6
DO TRLR
DO HOLD
if $GET(ESCAPE)
QUIT
if $DATA(^TMP($JOB,"ENY2"))
DO DETHDR
End DoDot:3
End DoDot:2
if $GET(ESCAPE)
QUIT
+10 if $GET(ESCAPE)
QUIT
KILL X
SET $PIECE(X,"-",130)="-"
WRITE !,X
+11 WRITE !,"COUNT",?64,$JUSTIFY(TOTAL(STATION,"COUNT"),10)
+12 WRITE !,"TOTALS",?103,"$"_$JUSTIFY(TOTAL(STATION,"EST"),7),?113,"$"_$JUSTIFY(TOTAL(STATION,"ACT"),7)
SET LINE=LINE+3
+13 IF ALLSTN
IF '$ORDER(^TMP($JOB,"ENY2",STATION))
Begin DoDot:2
+14 WRITE !,"COUNT FOR ALL STATIONS",?64,$JUSTIFY(TOTAL("COUNT"),10)
+15 WRITE !,"TOTALS FOR ALL STATIONS",?103,"$"_$JUSTIFY(TOTAL("EST"),7),?113,"$"_$JUSTIFY(TOTAL("ACT"),7)
SET LINE=LINE+2
End DoDot:2
+16 FOR
if (IOSL-LINE)'>5
QUIT
WRITE !
SET LINE=LINE+1
+17 DO TRLR
End DoDot:1
DO HOLD
if $GET(ESCAPE)
QUIT
WRITE @IOF
+18 ;return to ^eny2rep3 for exit
QUIT
+19 ;
DETHDR ; header for Y2K detail
+1 if $EXTRACT(IOST,1,2)="C-"!(PAGE)
WRITE @IOF
SET PAGE=PAGE+1
SET LINE=3
+2 WRITE "Detailed Y2K Equipment Report "
+3 WRITE $SELECT(CRITER=1:"by EQUIPMENT CATEGORY",CRITER=2:"by CATEGORY STOCK NUMBER",CRITER=3:"by CMR",CRITER=4:"by SERVICE",CRITER=5:"by MANUFACTURER",CRITER=6:"by LOCAL ID",CRITER=7:"by RESPONSIBLE SHOP",1:"for ENTIRE EQUIP FILE")
+4 WRITE " ("_$EXTRACT(SORT,1,20)_") "_DATE("PRNT")_" "_$SELECT('ALLSTN:"Consolidated",1:"Station: "_STATION)_" Page: "_PAGE
+5 IF ENSUP
WRITE !,"Equipment Records with Y2K Category of 'FC' or 'NA' are not being counted."
SET LINE=LINE+1
+6 WRITE !,"Manufacturer~Model",?45,"Equipment Category",?67,"Entry #",?76,"Y2K Est Date Act Date Est Cost Act Cost Action"
+7 KILL X
SET $PIECE(X,"-",130)="-"
WRITE !,X
+8 QUIT
+9 ;
TRLR ; print legend at bottom
+1 KILL X
SET $PIECE(X,"-",130)="-"
WRITE !,X
+2 WRITE !,"Y2K: FC=>Fully Compliant NC=>Noncompliant CC=>Conditionally Compliant NA=>Not Applicable Null=>No Y2K Information"
+3 WRITE !,"ACTION (Noncompliant Only): REP=>Replace RET=>Retire UPD=>Update to Full Compliance USE=>Use Without an Update"
+4 WRITE !
+5 QUIT
+6 ;
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 ;ENY2REPC
