ENY2REPA ;:(WIRMFO)/DH-Y2K Cum by Functional Category ;7.30.98
;;7.0;ENGINEERING;**51,55**;August 17, 1993
EN W @IOF,!,?21,"Y2K PROFILE BY FUNCTIONAL CATEGORY"
W !!,"There are approximately "_$P(^ENG(6914,0),U,4)_" entries in your Equipment file. Inactive entries"
W !,"(USE STATUS of 'TURNED-IN' or 'LOST OR STOLEN') will be automatically excluded",!,"from Y2K consideration (unless they were turned in due to Y2K non-compliance)."
W !!,"Equipment entries without a MANUFACTURER and a MODEL will also be excluded",!,"from Y2K consideration."
I $P($G(^DIC(6910,1,0)),U,2)']"" W !!,"There is no STATION NUMBER in your Engineering Init Parameters file.",!,"Can't proceed.",*7 Q
S ENSTN=0
I $P(^DIC(6910,1,0),U,10)!($D(^DIC(6910,1,3))) D I ENSTN="^" K ENSTN 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="DEQ^ENY2REPA" D G EXIT
. S ZTDESC="Y2K Equipment Classification Cumulative",ZTIO=ION
. S ZTSAVE("EN*")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
;
DEQ ; get the net results to date
N COUNT,TOTAL,STATION,DA,COST,MONTH,YEAR,CLASS,TYPE,ESCAPE
DEQ1 S STATION("PARNT")=$P(^DIC(6910,1,0),U,2),STATION=STATION("PARNT")
; begin initialization
F K=0,"PC","MED","FS","TEL" F J="ACT","Y2K",0,"FC","NC","CC","NA" S COUNT(STATION,K,J)=0
F K=0,"PC","MED","FS","TEL" F J=0,"REP","RET","USE" S COUNT(STATION,K,"NC",J)=0
F K=0,"PC","MED","FS","TEL" S COUNT(STATION,K,"NC","ATD")=0
F K=0,"PC","MED","FS","TEL" F J="ETD","ATD","ETOT" S TOTAL(STATION,K,"NC",J)=0
F K=0,"PC","MED","FS","TEL" S COUNT(STATION,K,"FC","UPG")=0
F K=0,"PC","MED","FS","TEL" F J="ECST","ACST" S COUNT(STATION,K,"FC",J)=0,TOTAL(STATION,K,"FC",J)=0
F K=0,"PC","MED","FS","TEL" S TOTAL(STATION,K,"CC","ECST")=0
F K=0,"NX","BSE","EXP" S COUNT(STATION,"TYPE",K)=0
F K=0,"PC","MED","FS","TEL" S COUNT(STATION,K,"NC","RETACT")=0
; end initialization
; begin data collection
DATA S STATION=STATION("PARNT"),DA=0 F S DA=$O(^ENG(6914,DA)) Q:'DA D
. Q:'$D(^ENG(6914,DA,0))
. I "^4^5^"[(U_$P($G(^ENG(6914,DA,3)),U)_U),$P($G(^(11)),U)'="NC" Q ;inactive and not Y2K NC
. I '$D(ZTQUEUED),'(DA#100) W "." ; activity indicator
. I ENSTN S STATION=$S($P($G(^ENG(6914,DA,9)),U,5)]"":$P(^(9),U,5),1:STATION("PARNT")) D:'$D(COUNT(STATION))
.. F K=0,"PC","MED","FS","TEL" F J="ACT","Y2K",0,"FC","NC","CC","NA" S COUNT(STATION,K,J)=0
.. F K=0,"PC","MED","FS","TEL" F J=0,"REP","RET","USE" S COUNT(STATION,K,"NC",J)=0
.. F K=0,"PC","MED","FS","TEL" S COUNT(STATION,K,"NC","ATD")=0
.. F K=0,"PC","MED","FS","TEL" F J="ETD","ATD","ETOT" S TOTAL(STATION,K,"NC",J)=0
.. F K=0,"PC","MED","FS","TEL" S COUNT(STATION,K,"FC","UPG")=0
.. F K=0,"PC","MED","FS","TEL" F J="ECST","ACST" S COUNT(STATION,K,"FC",J)=0,TOTAL(STATION,K,"FC",J)=0
.. F K=0,"PC","MED","FS","TEL" S TOTAL(STATION,K,"CC","ECST")=0
.. F K=0,"NX","BSE","EXP" S COUNT(STATION,"TYPE",K)=0
.. F K=0,"PC","MED","FS","TEL" S COUNT(STATION,K,"NC","RETACT")=0
. S CLASS=$P($G(^ENG(6914,DA,9)),U,11) S:CLASS="" CLASS=0
. S COUNT(STATION,CLASS,"ACT")=COUNT(STATION,CLASS,"ACT")+1
. S EN=$G(^ENG(6914,DA,11)) I $P(EN,U)="" Q:$P($G(^ENG(6914,DA,1)),U,4)="" Q:$P(^(1),U,2)="" ;not deemed a Y2K candidate
. S COUNT(STATION,CLASS,"Y2K")=COUNT(STATION,CLASS,"Y2K")+1
. I CLASS=0 D
.. S TYPE=$P(^ENG(6914,DA,0),U,4) S:TYPE="" TYPE=0
.. S COUNT(STATION,"TYPE",TYPE)=COUNT(STATION,"TYPE",TYPE)+1
. S ENY2K("CAT")=$P(EN,U) I ENY2K("CAT")="" S COUNT(STATION,CLASS,0)=COUNT(STATION,CLASS,0)+1 Q ;no Y2K info
. S COUNT(STATION,CLASS,ENY2K("CAT"))=COUNT(STATION,CLASS,ENY2K("CAT"))+1
. I ENY2K("CAT")="FC" D Q ;fully compliant
.. I $P(^ENG(6914,DA,11),U,9)]"" D
... S COUNT(STATION,CLASS,"FC","UPG")=COUNT(STATION,CLASS,"FC","UPG")+1
... I $P(EN,U,3)]"" S COUNT(STATION,CLASS,"FC","ECST")=COUNT(STATION,CLASS,"FC","ECST")+1,TOTAL(STATION,CLASS,"FC","ECST")=TOTAL(STATION,CLASS,"FC","ECST")+$P(EN,U,3)
... I $P(EN,U,4)]"" S COUNT(STATION,CLASS,"FC","ACST")=COUNT(STATION,CLASS,"FC","ACST")+1,TOTAL(STATION,CLASS,"FC","ACST")=TOTAL(STATION,CLASS,"FC","ACST")+$P(EN,U,4)
. ;
. I ENY2K("CAT")="NC" D Q ;non-compliant
.. S ENY2K("ACT")=$P(EN,U,6) S:ENY2K("ACT")="" ENY2K("ACT")=0 S COUNT(STATION,CLASS,"NC",ENY2K("ACT"))=COUNT(STATION,CLASS,"NC",ENY2K("ACT"))+1
.. I ENY2K("ACT")="REP" D
... S COST("E")=$P($G(^ENG(6914,DA,2)),U,3),TOTAL(STATION,CLASS,"NC","ETOT")=TOTAL(STATION,CLASS,"NC","ETOT")+COST("E")
... I $D(^ENG(6914,"AO",DA)) D
.... S COUNT(STATION,CLASS,"NC","ATD")=COUNT(STATION,CLASS,"NC","ATD")+1,TOTAL(STATION,CLASS,"NC","ETD")=TOTAL(STATION,CLASS,"NC","ETD")+COST("E")
.... S DA(1)=$O(^ENG(6914,"AO",DA,0)) I DA(1) S TOTAL(STATION,CLASS,"NC","ATD")=TOTAL(STATION,CLASS,"NC","ATD")+$P($G(^ENG(6914,DA(1),2)),U,3)
.. I ENY2K("ACT")="RET" D
... I "^4^5^"[(U_$P($G(^ENG(6914,DA,3)),U)_U) S COUNT(STATION,CLASS,"NC","RETACT")=COUNT(STATION,CLASS,"NC","RETACT")+1
. I ENY2K("CAT")="CC" D ;conditionally compliant
.. S TOTAL(STATION,CLASS,"CC","ECST")=TOTAL(STATION,CLASS,"CC","ECST")+$P(EN,U,3)
. ; end of data collection
Q:$G(ENY2K("VACO")) ; invoked for national roll-up
D PRT^ENY2REPB ;print routine
EXIT I $D(ZTQUEUED) S ZTREQN="@"
D ^%ZISC,HOME^%ZIS
K ENSTN
Q
;ENY2REPA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2REPA 5525 printed Apr 09, 2024@21:00:25 Page 2
ENY2REPA ;:(WIRMFO)/DH-Y2K Cum by Functional Category ;7.30.98
+1 ;;7.0;ENGINEERING;**51,55**;August 17, 1993
EN WRITE @IOF,!,?21,"Y2K PROFILE BY FUNCTIONAL CATEGORY"
+1 WRITE !!,"There are approximately "_$PIECE(^ENG(6914,0),U,4)_" entries in your Equipment file. Inactive entries"
+2 WRITE !,"(USE STATUS of 'TURNED-IN' or 'LOST OR STOLEN') will be automatically excluded",!,"from Y2K consideration (unless they were turned in due to Y2K non-compliance)."
+3 WRITE !!,"Equipment entries without a MANUFACTURER and a MODEL will also be excluded",!,"from Y2K consideration."
+4 IF $PIECE($GET(^DIC(6910,1,0)),U,2)']""
WRITE !!,"There is no STATION NUMBER in your Engineering Init Parameters file.",!,"Can't proceed.",*7
QUIT
+5 SET ENSTN=0
+6 IF $PIECE(^DIC(6910,1,0),U,10)!($DATA(^DIC(6910,1,3)))
Begin DoDot:1
+7 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want a breakout by station"
SET DIR("B")="NO"
+8 SET DIR("?",1)="If you say 'NO' you will obtain a single report for all your equipment,"
+9 SET DIR("?")="regardless of which station it belongs to."
+10 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ENSTN="^"
QUIT
+11 SET ENSTN=Y
End DoDot:1
IF ENSTN="^"
KILL ENSTN
QUIT
+12 WRITE !!
KILL IO("Q")
SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+13 IF $DATA(IO("Q"))
SET ZTRTN="DEQ^ENY2REPA"
Begin DoDot:1
+14 SET ZTDESC="Y2K Equipment Classification Cumulative"
SET ZTIO=ION
+15 SET ZTSAVE("EN*")=""
+16 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+17 ;
DEQ ; get the net results to date
+1 NEW COUNT,TOTAL,STATION,DA,COST,MONTH,YEAR,CLASS,TYPE,ESCAPE
DEQ1 SET STATION("PARNT")=$PIECE(^DIC(6910,1,0),U,2)
SET STATION=STATION("PARNT")
+1 ; begin initialization
+2 FOR K=0,"PC","MED","FS","TEL"
FOR J="ACT","Y2K",0,"FC","NC","CC","NA"
SET COUNT(STATION,K,J)=0
+3 FOR K=0,"PC","MED","FS","TEL"
FOR J=0,"REP","RET","USE"
SET COUNT(STATION,K,"NC",J)=0
+4 FOR K=0,"PC","MED","FS","TEL"
SET COUNT(STATION,K,"NC","ATD")=0
+5 FOR K=0,"PC","MED","FS","TEL"
FOR J="ETD","ATD","ETOT"
SET TOTAL(STATION,K,"NC",J)=0
+6 FOR K=0,"PC","MED","FS","TEL"
SET COUNT(STATION,K,"FC","UPG")=0
+7 FOR K=0,"PC","MED","FS","TEL"
FOR J="ECST","ACST"
SET COUNT(STATION,K,"FC",J)=0
SET TOTAL(STATION,K,"FC",J)=0
+8 FOR K=0,"PC","MED","FS","TEL"
SET TOTAL(STATION,K,"CC","ECST")=0
+9 FOR K=0,"NX","BSE","EXP"
SET COUNT(STATION,"TYPE",K)=0
+10 FOR K=0,"PC","MED","FS","TEL"
SET COUNT(STATION,K,"NC","RETACT")=0
+11 ; end initialization
+12 ; begin data collection
DATA SET STATION=STATION("PARNT")
SET DA=0
FOR
SET DA=$ORDER(^ENG(6914,DA))
if 'DA
QUIT
Begin DoDot:1
+1 if '$DATA(^ENG(6914,DA,0))
QUIT
+2 ;inactive and not Y2K NC
IF "^4^5^"[(U_$PIECE($GET(^ENG(6914,DA,3)),U)_U)
IF $PIECE($GET(^(11)),U)'="NC"
QUIT
+3 ; activity indicator
IF '$DATA(ZTQUEUED)
IF '(DA#100)
WRITE "."
+4 IF ENSTN
SET STATION=$SELECT($PIECE($GET(^ENG(6914,DA,9)),U,5)]"":$PIECE(^(9),U,5),1:STATION("PARNT"))
if '$DATA(COUNT(STATION))
Begin DoDot:2
+5 FOR K=0,"PC","MED","FS","TEL"
FOR J="ACT","Y2K",0,"FC","NC","CC","NA"
SET COUNT(STATION,K,J)=0
+6 FOR K=0,"PC","MED","FS","TEL"
FOR J=0,"REP","RET","USE"
SET COUNT(STATION,K,"NC",J)=0
+7 FOR K=0,"PC","MED","FS","TEL"
SET COUNT(STATION,K,"NC","ATD")=0
+8 FOR K=0,"PC","MED","FS","TEL"
FOR J="ETD","ATD","ETOT"
SET TOTAL(STATION,K,"NC",J)=0
+9 FOR K=0,"PC","MED","FS","TEL"
SET COUNT(STATION,K,"FC","UPG")=0
+10 FOR K=0,"PC","MED","FS","TEL"
FOR J="ECST","ACST"
SET COUNT(STATION,K,"FC",J)=0
SET TOTAL(STATION,K,"FC",J)=0
+11 FOR K=0,"PC","MED","FS","TEL"
SET TOTAL(STATION,K,"CC","ECST")=0
+12 FOR K=0,"NX","BSE","EXP"
SET COUNT(STATION,"TYPE",K)=0
+13 FOR K=0,"PC","MED","FS","TEL"
SET COUNT(STATION,K,"NC","RETACT")=0
End DoDot:2
+14 SET CLASS=$PIECE($GET(^ENG(6914,DA,9)),U,11)
if CLASS=""
SET CLASS=0
+15 SET COUNT(STATION,CLASS,"ACT")=COUNT(STATION,CLASS,"ACT")+1
+16 ;not deemed a Y2K candidate
SET EN=$GET(^ENG(6914,DA,11))
IF $PIECE(EN,U)=""
if $PIECE($GET(^ENG(6914,DA,1)),U,4)=""
QUIT
if $PIECE(^(1),U,2)=""
QUIT
+17 SET COUNT(STATION,CLASS,"Y2K")=COUNT(STATION,CLASS,"Y2K")+1
+18 IF CLASS=0
Begin DoDot:2
+19 SET TYPE=$PIECE(^ENG(6914,DA,0),U,4)
if TYPE=""
SET TYPE=0
+20 SET COUNT(STATION,"TYPE",TYPE)=COUNT(STATION,"TYPE",TYPE)+1
End DoDot:2
+21 ;no Y2K info
SET ENY2K("CAT")=$PIECE(EN,U)
IF ENY2K("CAT")=""
SET COUNT(STATION,CLASS,0)=COUNT(STATION,CLASS,0)+1
QUIT
+22 SET COUNT(STATION,CLASS,ENY2K("CAT"))=COUNT(STATION,CLASS,ENY2K("CAT"))+1
+23 ;fully compliant
IF ENY2K("CAT")="FC"
Begin DoDot:2
+24 IF $PIECE(^ENG(6914,DA,11),U,9)]""
Begin DoDot:3
+25 SET COUNT(STATION,CLASS,"FC","UPG")=COUNT(STATION,CLASS,"FC","UPG")+1
+26 IF $PIECE(EN,U,3)]""
SET COUNT(STATION,CLASS,"FC","ECST")=COUNT(STATION,CLASS,"FC","ECST")+1
SET TOTAL(STATION,CLASS,"FC","ECST")=TOTAL(STATION,CLASS,"FC","ECST")+$PIECE(EN,U,3)
+27 IF $PIECE(EN,U,4)]""
SET COUNT(STATION,CLASS,"FC","ACST")=COUNT(STATION,CLASS,"FC","ACST")+1
SET TOTAL(STATION,CLASS,"FC","ACST")=TOTAL(STATION,CLASS,"FC","ACST")+$PIECE(EN,U,4)
End DoDot:3
End DoDot:2
QUIT
+28 ;
+29 ;non-compliant
IF ENY2K("CAT")="NC"
Begin DoDot:2
+30 SET ENY2K("ACT")=$PIECE(EN,U,6)
if ENY2K("ACT")=""
SET ENY2K("ACT")=0
SET COUNT(STATION,CLASS,"NC",ENY2K("ACT"))=COUNT(STATION,CLASS,"NC",ENY2K("ACT"))+1
+31 IF ENY2K("ACT")="REP"
Begin DoDot:3
+32 SET COST("E")=$PIECE($GET(^ENG(6914,DA,2)),U,3)
SET TOTAL(STATION,CLASS,"NC","ETOT")=TOTAL(STATION,CLASS,"NC","ETOT")+COST("E")
+33 IF $DATA(^ENG(6914,"AO",DA))
Begin DoDot:4
+34 SET COUNT(STATION,CLASS,"NC","ATD")=COUNT(STATION,CLASS,"NC","ATD")+1
SET TOTAL(STATION,CLASS,"NC","ETD")=TOTAL(STATION,CLASS,"NC","ETD")+COST("E")
+35 SET DA(1)=$ORDER(^ENG(6914,"AO",DA,0))
IF DA(1)
SET TOTAL(STATION,CLASS,"NC","ATD")=TOTAL(STATION,CLASS,"NC","ATD")+$PIECE($GET(^ENG(6914,DA(1),2)),U,3)
End DoDot:4
End DoDot:3
+36 IF ENY2K("ACT")="RET"
Begin DoDot:3
+37 IF "^4^5^"[(U_$PIECE($GET(^ENG(6914,DA,3)),U)_U)
SET COUNT(STATION,CLASS,"NC","RETACT")=COUNT(STATION,CLASS,"NC","RETACT")+1
End DoDot:3
End DoDot:2
QUIT
+38 ;conditionally compliant
IF ENY2K("CAT")="CC"
Begin DoDot:2
+39 SET TOTAL(STATION,CLASS,"CC","ECST")=TOTAL(STATION,CLASS,"CC","ECST")+$PIECE(EN,U,3)
End DoDot:2
+40 ; end of data collection
End DoDot:1
+41 ; invoked for national roll-up
if $GET(ENY2K("VACO"))
QUIT
+42 ;print routine
DO PRT^ENY2REPB
EXIT IF $DATA(ZTQUEUED)
SET ZTREQN="@"
+1 DO ^%ZISC
DO HOME^%ZIS
+2 KILL ENSTN
+3 QUIT
+4 ;ENY2REPA
