ENY2REP3 ;;(WIRMFO)/DH-Y2K Detail by Man~Mod ;1.19.99
;;7.0;ENGINEERING;**51,55,61**;August 17, 1993
;
DET ; detailed snapshot of Y2K data base by manufacturer~model
; list can include all items or a user specified subset
W @IOF,!!,?15,"** DETAILED REPORT OF Y2K EQUIPMENT DATA BASE **"
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
N ALLSTN,ENSUP,CRITER,ESCAPE,ENY2K,DATE,CAT,CSN,CMR,SRVC,MFG,LOC,END,SHOP,SORT
S ALLSTN=0
I $P(^DIC(6910,1,0),U,1)!($D(^DIC(6910,1,3))) D Q:ALLSTN="^"
. 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 ALLSTN="^" Q
. S ALLSTN=Y
Q:ALLSTN=U
W !! S DIR(0)="YA",DIR("A")="Shall we ignore equipment records with no Y2K issues? ",DIR("B")="YES"
S DIR("?",1)="Enter YES if you do not wish the counts to include equipment records for"
S DIR("?")="which the Y2K CATEGORY is 'FC' or 'NA'."
D ^DIR K DIR Q:$D(DIRUT)
S ENSUP=Y
W !!,"Shall we ignore equipment entries for which either the MANUFACTURER or the" S DIR("A")="MODEL field is null"
S DIR(0)="Y",DIR("B")="YES"
S DIR("?",1)="Line items on a Detailed Y2K Report that do not contain both a MANUFACTURER"
S DIR("?",2)="and a MODEL may be of limited value. Enter 'YES' at this point if you wish"
S DIR("?")="to suppress them."
D ^DIR K DIR Q:$D(DIRUT)
S ENY2K("INC")='Y
W !! S DIR(0)="SM^1:EQUIPMENT CATEGORY;2:CATEGORY STOCK NUMBER;3:CMR;4:SERVICE;5:MANUFACTURER;6:LOCAL ID;7:RESPONSIBLE SHOP;8:ENTIRE FILE"
S DIR("A")="How should Equipment Records be selected",DIR("B")="EQUIPMENT CATEGORY"
S DIR("?",1)="Unless you choose ENTIRE FILE, the system will look only at those equipment"
S DIR("?")="records that match your selection criteria."
D ^DIR K DIR Q:$D(DIRUT)
S CRITER=Y
I CRITER=1 N CAT D CAT1^ENY2K Q:$G(ESCAPE) S SORT=CAT G DEV
I CRITER=2 N CSN D CSN1^ENY2K Q:$G(ESCAPE) S SORT=CSN G DEV
I CRITER=3 N CMR D CMR Q:$G(ESCAPE) S SORT=CMR G DEV
I CRITER=4 N SRVC D SRVC Q:$G(ESCAPE) S SORT=SRVC G DEV
I CRITER=5 N MFG D MFG1^ENY2K Q:$G(ESCAPE) S SORT=MFG G DEV
I CRITER=6 N LOC,END D LOC1^ENY2K9 Q:$G(ESCAPE) S SORT=LOC_"=>"_END G DEV
I CRITER=7 N SHOP D SHOP Q:$G(ESCAPE) S SORT=SHOP G DEV
I CRITER=8 D S SORT="ENTIRE FILE" G DEV
. S DA=0 F S DA=$O(^ENG(6914,DA)) Q:'DA W:'(DA#200) "." I $D(^(DA,0)),"^4^5^"'[(U_$P($G(^(3)),U)_U) S ^TMP($J,DA)=""
Q ;error condition
;
CMR K ^TMP($J)
S DIC="^ENG(6914.1,",DIC(0)="AEQM" D ^DIC I Y'>0 S ESCAPE=1 Q
S CMR=$P(Y,U,2),CMR(0)=$P(Y,U)
S (COUNT,DA)=0 F S DA=$O(^ENG(6914,"AD",CMR(0),DA)) Q:'DA I $D(^ENG(6914,DA,0)),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)=""
I 'COUNT W !!,"There are no active equipment records in CMR "_CMR_"." G CMR
W !!,"There are "_COUNT_" active equipment records in CMR "_CMR_".",!,"Do you wish to proceed?"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
S ENY2K("CONT")=Y I 'ENY2K("CONT") G CMR
Q
;
SRVC K ^TMP($J)
S DIC="^DIC(49,",DIC(0)="AEQM" D ^DIC I Y'>0 S ESCAPE=1 Q
S SRVC=$P(Y,U,2),SRVC(0)=$P(Y,U)
S (COUNT,DA)=0 F S DA=$O(^ENG(6914,"AC",SRVC(0),DA)) Q:'DA I $D(^ENG(6914,DA,0)),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)=""
I 'COUNT W !!,"There are no active equipment entries assigned to "_SRVC_"." G SRVC
W !!,"There are "_COUNT_" active equipment entries assigned to "_SRVC_".","Do you wish to proceed?"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
S ENY2K("CONT")=Y I 'ENY2K("CONT") G SRVC
Q
;
SHOP K ^TMP($J)
S DIC="^DIC(6922,",DIC(0)="AEQM" D ^DIC I Y'>0 S ESCAPE=1 Q
S SHOP=$P(Y,U,2),SHOP(0)=$P(Y,U)
S (COUNT,DA)=0 F S DA=$O(^ENG(6914,DA)) Q:'DA W:'(DA#100) "." I $D(^(0)),$P($G(^(11)),U,7)=SHOP(0),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)=""
S DA=0 F S DA=$O(^ENG(6914,"AB",SHOP(0),DA)) Q:'DA I $D(^ENG(6914,DA,0)),"^4^5^"'[(U_$P($G(^(3)),U)_U) S COUNT=COUNT+1,^TMP($J,DA)=""
I 'COUNT W !!,"There are no equipment entries assigned to "_SHOP_"." G SHOP
W !!,"There are "_COUNT_" equipment entries assigned to "_SHOP_".",!,"Do you wish to continue?"
S DIR(0)="Y",DIR("B")="YES"
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
S ENY2K("CONT")=Y I 'ENY2K("CONT") G SHOP
Q
;
DEV W !! K IO("Q") S %ZIS="QM" D ^%ZIS G:POP EXIT
I IOM<130 W !,"Sorry, but this report requires at least 130 columns.",*7 G DEV
I $D(IO("Q")) S ZTRTN="DEQDET^ENY2REP3" D G EXIT
. S ZTDESC="Y2K Equipment Snapshot",ZTIO=ION
. S ZTSAVE("ALLSTN")="",ZTSAVE("ENSUP")="",ZTSAVE("CRITER")=""
. D NOW^%DTC S DATE=%,ZTSAVE("DATE")="",ZTSAVE("SORT")=""
. S %X="^TMP($J,",%Y="^XUTL(""ENY2"",DATE," D %XY^%RCR
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
;
DEQDET ;
D DEQDET^ENY2REPC
G EXIT
;
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
EXIT ;
K ^TMP($J)
I '$D(ZTQUEUED) D ^%ZISC,HOME^%ZIS
I $D(ZTQUEUED) K ALLSTN,ENSUP,CRITER,SORT S ZTREQN="@"
K J,K,X
Q
;ENY2REP3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2REP3 5249 printed Apr 09, 2024@20:58:47 Page 2
ENY2REP3 ;;(WIRMFO)/DH-Y2K Detail by Man~Mod ;1.19.99
+1 ;;7.0;ENGINEERING;**51,55,61**;August 17, 1993
+2 ;
DET ; detailed snapshot of Y2K data base by manufacturer~model
+1 ; list can include all items or a user specified subset
+2 WRITE @IOF,!!,?15,"** DETAILED REPORT OF Y2K EQUIPMENT DATA BASE **"
+3 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
+4 NEW ALLSTN,ENSUP,CRITER,ESCAPE,ENY2K,DATE,CAT,CSN,CMR,SRVC,MFG,LOC,END,SHOP,SORT
+5 SET ALLSTN=0
+6 IF $PIECE(^DIC(6910,1,0),U,1)!($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 ALLSTN="^"
QUIT
+11 SET ALLSTN=Y
End DoDot:1
if ALLSTN="^"
QUIT
+12 if ALLSTN=U
QUIT
+13 WRITE !!
SET DIR(0)="YA"
SET DIR("A")="Shall we ignore equipment records with no Y2K issues? "
SET DIR("B")="YES"
+14 SET DIR("?",1)="Enter YES if you do not wish the counts to include equipment records for"
+15 SET DIR("?")="which the Y2K CATEGORY is 'FC' or 'NA'."
+16 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+17 SET ENSUP=Y
+18 WRITE !!,"Shall we ignore equipment entries for which either the MANUFACTURER or the"
SET DIR("A")="MODEL field is null"
+19 SET DIR(0)="Y"
SET DIR("B")="YES"
+20 SET DIR("?",1)="Line items on a Detailed Y2K Report that do not contain both a MANUFACTURER"
+21 SET DIR("?",2)="and a MODEL may be of limited value. Enter 'YES' at this point if you wish"
+22 SET DIR("?")="to suppress them."
+23 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+24 SET ENY2K("INC")='Y
+25 WRITE !!
SET DIR(0)="SM^1:EQUIPMENT CATEGORY;2:CATEGORY STOCK NUMBER;3:CMR;4:SERVICE;5:MANUFACTURER;6:LOCAL ID;7:RESPONSIBLE SHOP;8:ENTIRE FILE"
+26 SET DIR("A")="How should Equipment Records be selected"
SET DIR("B")="EQUIPMENT CATEGORY"
+27 SET DIR("?",1)="Unless you choose ENTIRE FILE, the system will look only at those equipment"
+28 SET DIR("?")="records that match your selection criteria."
+29 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+30 SET CRITER=Y
+31 IF CRITER=1
NEW CAT
DO CAT1^ENY2K
if $GET(ESCAPE)
QUIT
SET SORT=CAT
GOTO DEV
+32 IF CRITER=2
NEW CSN
DO CSN1^ENY2K
if $GET(ESCAPE)
QUIT
SET SORT=CSN
GOTO DEV
+33 IF CRITER=3
NEW CMR
DO CMR
if $GET(ESCAPE)
QUIT
SET SORT=CMR
GOTO DEV
+34 IF CRITER=4
NEW SRVC
DO SRVC
if $GET(ESCAPE)
QUIT
SET SORT=SRVC
GOTO DEV
+35 IF CRITER=5
NEW MFG
DO MFG1^ENY2K
if $GET(ESCAPE)
QUIT
SET SORT=MFG
GOTO DEV
+36 IF CRITER=6
NEW LOC,END
DO LOC1^ENY2K9
if $GET(ESCAPE)
QUIT
SET SORT=LOC_"=>"_END
GOTO DEV
+37 IF CRITER=7
NEW SHOP
DO SHOP
if $GET(ESCAPE)
QUIT
SET SORT=SHOP
GOTO DEV
+38 IF CRITER=8
Begin DoDot:1
+39 SET DA=0
FOR
SET DA=$ORDER(^ENG(6914,DA))
if 'DA
QUIT
if '(DA#200)
WRITE "."
IF $DATA(^(DA,0))
IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
SET ^TMP($JOB,DA)=""
End DoDot:1
SET SORT="ENTIRE FILE"
GOTO DEV
+40 ;error condition
QUIT
+41 ;
CMR KILL ^TMP($JOB)
+1 SET DIC="^ENG(6914.1,"
SET DIC(0)="AEQM"
DO ^DIC
IF Y'>0
SET ESCAPE=1
QUIT
+2 SET CMR=$PIECE(Y,U,2)
SET CMR(0)=$PIECE(Y,U)
+3 SET (COUNT,DA)=0
FOR
SET DA=$ORDER(^ENG(6914,"AD",CMR(0),DA))
if 'DA
QUIT
IF $DATA(^ENG(6914,DA,0))
IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
SET COUNT=COUNT+1
SET ^TMP($JOB,DA)=""
+4 IF 'COUNT
WRITE !!,"There are no active equipment records in CMR "_CMR_"."
GOTO CMR
+5 WRITE !!,"There are "_COUNT_" active equipment records in CMR "_CMR_".",!,"Do you wish to proceed?"
+6 SET DIR(0)="Y"
SET DIR("B")="YES"
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+8 SET ENY2K("CONT")=Y
IF 'ENY2K("CONT")
GOTO CMR
+9 QUIT
+10 ;
SRVC KILL ^TMP($JOB)
+1 SET DIC="^DIC(49,"
SET DIC(0)="AEQM"
DO ^DIC
IF Y'>0
SET ESCAPE=1
QUIT
+2 SET SRVC=$PIECE(Y,U,2)
SET SRVC(0)=$PIECE(Y,U)
+3 SET (COUNT,DA)=0
FOR
SET DA=$ORDER(^ENG(6914,"AC",SRVC(0),DA))
if 'DA
QUIT
IF $DATA(^ENG(6914,DA,0))
IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
SET COUNT=COUNT+1
SET ^TMP($JOB,DA)=""
+4 IF 'COUNT
WRITE !!,"There are no active equipment entries assigned to "_SRVC_"."
GOTO SRVC
+5 WRITE !!,"There are "_COUNT_" active equipment entries assigned to "_SRVC_".","Do you wish to proceed?"
+6 SET DIR(0)="Y"
SET DIR("B")="YES"
+7 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+8 SET ENY2K("CONT")=Y
IF 'ENY2K("CONT")
GOTO SRVC
+9 QUIT
+10 ;
SHOP KILL ^TMP($JOB)
+1 SET DIC="^DIC(6922,"
SET DIC(0)="AEQM"
DO ^DIC
IF Y'>0
SET ESCAPE=1
QUIT
+2 SET SHOP=$PIECE(Y,U,2)
SET SHOP(0)=$PIECE(Y,U)
+3 SET (COUNT,DA)=0
FOR
SET DA=$ORDER(^ENG(6914,DA))
if 'DA
QUIT
if '(DA#100)
WRITE "."
IF $DATA(^(0))
IF $PIECE($GET(^(11)),U,7)=SHOP(0)
IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
SET COUNT=COUNT+1
SET ^TMP($JOB,DA)=""
+4 SET DA=0
FOR
SET DA=$ORDER(^ENG(6914,"AB",SHOP(0),DA))
if 'DA
QUIT
IF $DATA(^ENG(6914,DA,0))
IF "^4^5^"'[(U_$PIECE($GET(^(3)),U)_U)
SET COUNT=COUNT+1
SET ^TMP($JOB,DA)=""
+5 IF 'COUNT
WRITE !!,"There are no equipment entries assigned to "_SHOP_"."
GOTO SHOP
+6 WRITE !!,"There are "_COUNT_" equipment entries assigned to "_SHOP_".",!,"Do you wish to continue?"
+7 SET DIR(0)="Y"
SET DIR("B")="YES"
+8 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+9 SET ENY2K("CONT")=Y
IF 'ENY2K("CONT")
GOTO SHOP
+10 QUIT
+11 ;
DEV WRITE !!
KILL IO("Q")
SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+1 IF IOM<130
WRITE !,"Sorry, but this report requires at least 130 columns.",*7
GOTO DEV
+2 IF $DATA(IO("Q"))
SET ZTRTN="DEQDET^ENY2REP3"
Begin DoDot:1
+3 SET ZTDESC="Y2K Equipment Snapshot"
SET ZTIO=ION
+4 SET ZTSAVE("ALLSTN")=""
SET ZTSAVE("ENSUP")=""
SET ZTSAVE("CRITER")=""
+5 DO NOW^%DTC
SET DATE=%
SET ZTSAVE("DATE")=""
SET ZTSAVE("SORT")=""
+6 SET %X="^TMP($J,"
SET %Y="^XUTL(""ENY2"",DATE,"
DO %XY^%RCR
+7 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+8 ;
DEQDET ;
+1 DO DEQDET^ENY2REPC
+2 GOTO EXIT
+3 ;
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
EXIT ;
+1 KILL ^TMP($JOB)
+2 IF '$DATA(ZTQUEUED)
DO ^%ZISC
DO HOME^%ZIS
+3 IF $DATA(ZTQUEUED)
KILL ALLSTN,ENSUP,CRITER,SORT
SET ZTREQN="@"
+4 KILL J,K,X
+5 QUIT
+6 ;ENY2REP3
