- 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 Feb 18, 2025@23:23:56 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
