- 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 Jan 18, 2025@02:58:39 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