ENY2K5 ;(WASH ISC)/DH-Generate Y2K Work Orders ;7.15.99
;;7.0;ENGINEERING;**51,55,59,61**;Aug 17, 1993
; Creates or finds work orders for a specified Y2K worklist
; and then makes calls to print that document
; Global ^TMP($J,"ENY2"... contains sort order and equip entry numbers
;
; ENTECH indicates whether 'sort by tech' is in effect
; TECH => IEN for Engineering Employee file
; (0 => tech is undefined)
; ENEMP => employee name as character string (could be "UNASSIGNED")
;
PR ; Begin
I '$D(^TMP($J,"ENY2")) D Q
. W !!,"A Y2K Worklist was requested, but there's nothing to print."
. D NOW^%DTC S Y=% X ^DD("DD") W !,?5,"Run time: "_Y
. W !,?5,"Shop: "_$S(ENSHKEY("SEL")="ALL":"ALL",1:$P(^DIC(6922,ENSHKEY("SEL"),0),U))
. W !,?5,"Estimated Y2K Compliance Date: "_ENY2DT("E")
N I,J,K,X,X1,EN,ENX,TECH,DA,DIC,DIE
N H,W,SE,MULT,NODE,HDR,LINE,TIME,VACANT,SHOP
I IOM>93 S HDR="HDR96^ENY2K6",LINE="LN96^ENY2K7"
E S HDR="HDR80^ENY2K6",LINE="LN80^ENY2K7"
D NOW^%DTC S Y=%,ENDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)
I HDR="HDR96^ENY2K6" X ^DD("DD") S TIME=$P(Y,":",1,2)
S (TECH,ENPG,ENY)=0,ENEXPAND=1
U IO S X=""
S NODE="^TMP($J,""ENY2"",0)",NODE=$Q(@NODE),SUB=$QL(NODE)
S ENSHKEY=0,ENSHKEY(0)=$O(^TMP($J,"ENY2",0)) K ENXP
F Q:$G(X)="^" S ENSHKEY=$O(^TMP($J,"ENY2",ENSHKEY)) D:ENSHKEY'=ENSHKEY(0) COMP D:ENSHKEY="" HOLD Q:'ENSHKEY!($G(X)="^") S:ENTECH'=0 ENEMP=$O(^TMP($J,"ENY2",ENSHKEY,"")) S DA=$QS(NODE,SUB),ENHZ=@NODE D PR1
I $D(ENXP("LOCK")) W !!,"Abnormal termination. This worklist may be incomplete." H 5
D TRLR
G OUT ;Design EXIT
;
PR1 S ENSHOP=$P(^DIC(6922,ENSHKEY,0),U,1),ENSHABR=$P(^(0),U,2),ENCODE="Y2-"_ENSHABR_$E(DT,2,5),X=""
S ENWO=$O(^ENG(6920,"B",ENCODE_"-9999"),-1)
I ENWO'[ENCODE S ENWO=ENCODE_"-001"
E S J=$P(ENWO,"-",3)+1,J=$S($L(J)=1:"00"_J,$L(J)=2:"0"_J,1:J),$P(ENWO,"-",3)=J
;
I ENTECH=0 D Q ;Worklist without RESP TECH
. D TRLR,@HDR S ENPG(0)=ENPG F Q:$G(X)="^" D PR2 Q:$G(X)="^" S NODE=$Q(@NODE) Q:$QS(NODE,3)'=ENSHKEY S DA=$QS(NODE,SUB),ENHZ=@NODE Q:DA'>0
;
D EMP ;With RESP TECH (may or may not be sorted by tech)
D TRLR,@HDR S ENPG(0)=ENPG F Q:$G(X)="^" D PR2 Q:$G(X)="^" S NODE=$Q(@NODE) Q:$QS(NODE,3)'=ENSHKEY D Q:DA'>0
. I $QS(NODE,4)'=ENEMP S ENEMP=$QS(NODE,4) D EMP,TRLR,@HDR S ENPG(0)=ENPG
. S DA=$QS(NODE,SUB),ENHZ=@NODE
Q ;Return to design EXIT
;
PR2 ; need a work order?
Q:'$D(^ENG(6914,DA,11)) S ENWOX="",ENWO("P")=$P(^ENG(6914,DA,11),U,8),ENWO("T")=$P(^(11),U,9)
I ENWO("T")]"" D
. S J=0 F S J=$O(^ENG(6914,DA,6,J)) Q:J'>0 I $P(^ENG(6914,DA,6,J,0),U,2)=ENWO("T") S ENWOX="COMPLETE" Q
I ENWOX="COMPLETE" S ^TMP($J,"ENY2","COMP",DA)=ENWO("T") Q ; devices with completed Y2K work orders will not appear on worklist (don't need another work order)
I ENWO("P")>0,$D(^ENG(6920,ENWO("P"),0)) S ENWOX=ENWO("T") D Q
. I $P($G(^ENG(6920,ENWO("P"),4)),U,3)=5 S ^TMP($J,"ENY2","COMP",DA)=ENWO("T") Q ; wo exists, but is disapproved
. D PR3 ; use existing Y2K work order
I ENWO("T")]"" S ENWO=ENWO("T") D PR22,PR3 Q
D PR22,PR3
Q ;back to program segment PR1
;
PR22 ; must create a new work order from the top
; ENWO as set in line PR1+1 or from ENWO("T")
L +^ENG(6920,"B"):20 I '$T S ENXP("LOCK")=1 Q
;
PR221 I $D(^ENG(6920,"B",ENWO)) S J=$P(ENWO,"-",3)+1,J=$S($L(J)=1:"00"_J,$L(J)=2:"0"_J,1:J),ENWO=$P(ENWO,"-",1,2)_"-"_J G PR221
I ENWO("T")="",$D(^ENG(6914,"AL",ENWO)) S J=$P(ENWO,"-",3)+1,J=$S($L(J)=1:"00"_J,$L(J)=2:"0"_J,1:J),ENWO=$P(ENWO,"-",1,2)_"-"_J G PR221
S (X,ENWOX)=ENWO
;
PR222 ; create a work order when you already have the number
K DD,DO S DIC="^ENG(6920,",DIC(0)="LX",X=ENWO D FILE^DICN S ENNXL=+Y
L:ENNXL>0 +^ENG(6920,ENNXL):1
L -^ENG(6920,"B")
I ENNXL'>0 S ENXP("LOCK")=1 Q
S $P(^ENG(6914,DA,11),U,8)=ENNXL,$P(^(11),U,9)=ENWO,^ENG(6914,"AL",ENWO,DA)=""
S $P(^ENG(6920,ENNXL,0),U,2)=DT,$P(^(0),U,6)=ENWO,$P(^ENG(6920,ENNXL,3),U,8)=DA,^ENG(6920,"G",DA,ENNXL)="",^ENG(6920,ENNXL,2)=ENSHKEY
S X(1)=$O(^ENG(6920.1,"B","Y2K COMPLIANCE",0))
I X(1)>0,$D(^ENG(6920.1,X(1),0)) S ^ENG(6920,ENNXL,8,0)="^6920.035PA^1^1",^ENG(6920,ENNXL,8,1,0)=X(1)
I $D(^ENG(6914,DA,3)) S EN=^(3),ENPMN=$P(EN,U,6),ENLOC=$P(EN,U,5) S:ENPMN]"" $P(^ENG(6920,ENNXL,3),U)=ENPMN,^ENG(6920,"E",ENPMN,ENNXL)="" I ENLOC]"",ENLOC?.N S $P(^ENG(6920,ENNXL,0),U,4)=ENLOC,^ENG(6920,"C",ENLOC,ENNXL)=""
S $P(^ENG(6920,ENNXL,5),U,7)=$S($P(^ENG(6914,DA,11),U,12)]"":$P(^(11),U,12),1:"YEAR 2000 compliance.") ; work performed
I ENTECH=0 D ; ENEMP not included in input global
. S TECH=$P(^ENG(6914,DA,11),U,5) S:TECH="" TECH=0 I TECH>0 S:'$D(^ENG("EMP",TECH,0)) TECH=0
. S:TECH>0 ENEMP=$P(^ENG("EMP",TECH,0),U)
I TECH>0 D ;Set ASSIGNED and RESPONSIBLE TECH
. S $P(^ENG(6920,ENNXL,2),U,2)=TECH
. S SHOP=$S($P(^ENG(6914,DA,11),U,7)]"":$P(^(11),U,7),$P(^ENG("EMP",TECH,0),U,10)]"":$P(^(0),U,10),1:"")
. S ^ENG(6920,ENNXL,7,0)="^6920.02PA^1^1",^ENG(6920,ENNXL,7,1,0)=TECH_"^^"_SHOP
S ENDA=DA,DA=ENNXL D TEST^ENWOCOMP
I ENEXPAND D ST^ENWOINV S DIE="^ENG(6920,",DR="6///^S X=""Year 2000 compliance.""" D ^DIE
S DA=ENDA
I $P(EN,U,2)]""!($P(EN,U,3)]"") D WOCST
L -^ENG(6920,ENNXL)
S K=$P(ENWO,"-",3),K=K+1,K=$S($L(K)=1:"00"_K,$L(K)=2:"0"_K,1:K),ENWO=$P(ENWO,"-",1,2)_"-"_K ;increment in preparation for next hit
Q
;
PR3 ; do the printing
I ENY+12>IOSL D TRLR,@HDR Q:$G(X)="^"
D @LINE
Q
;
EMP S VACANT=0 I ENEMP=0 S TECH=0 Q
S TECH=$O(^ENG("EMP","B",ENEMP,0)) I TECH'>0 S TECH=0 Q
I '$D(^ENG("EMP",TECH,0)) S (TECH,ENEMP)=0 Q
S:$P(^ENG("EMP",TECH,0),U,7)="V" VACANT=1
Q
;
WOCST Q
;
HOLD I $G(ENPG(0))>0,ENPG=ENPG(0),ENY'>7 W !!,"There are no incomplete Y2K work orders to print.",!
I $E(IOST,1,2)="C-" R !,"Press <RETURN> to continue, '^' to escape...",X:DTIME S:'$T X=U
Q
;
TRLR ; Interpret PM STATUS and CONDITION CODE
I ENPG,($E(IOST,1,2)'="C-"!($D(IO("S")))) D
. F Q:$Y>(IOSL-4) W !
. K K S $P(K,"-",(IOM-1))="-" W K K K
. W !,"FC=>Y2K compliant NC=>Y2K non-compliant NA=>Not applicable (no Y2K issues)"
. W !,"CNL=>Could not locate TI=>Turned-in"
Q
;
COMP ; devices with completed Y2K work orders (exception messages)
Q:'$D(^TMP($J,"ENY2","COMP")) ; no exceptions
S ENPG=ENPG+1 D HOLD
W @IOF,"DEVICES WITH COMPLETED Y2K WORK ORDERS "_ENDATE_" Page "_ENPG
W !!,"The following device(s) have a Y2K CATEGORY of CONDITIONALLY COMPLIANT and",!,"yet their Y2K work order(s) are complete. They are not being printed on",!,"this Y2K worklist."
W !!,"You should probably use the 'Manual Equipment Selection for Y2K' option to",!,"change their Y2K CATEGORY to COMPLIANT."
K X S $P(X,"-",(IOM-2))="-" W !,X,!
S DA=0 F S DA=$O(^TMP($J,"ENY2","COMP",DA)) Q:'DA W !,?10,DA,?25,"("_^TMP($J,"ENY2","COMP",DA)_")"
K ^TMP($J,"ENY2","COMP")
Q
;
OUT K ENSHABR,ENCODE,ENWO,ENWOX,ENTECH,ENSRT,ENPG,ENY,ENPMN,ENID,ENMAN,ENMANF,ENMOD,ENSN,ENLID,ENLOC,ENPRC,ENPROC,ENDTYP,ENDVTYP,ENUSE,ENDA
K ENHZ,ENLVL,ENEMP,ENNXL,ENNXT,ENSTAT,ENFNO,ENSRVC,ENWING,ENHRS,ENMAT,ENEXPAND,ENCOND,ENX,ENMFGR,ENLABOR,ENDATE
K ^TMP($J)
I $E(IOST,1,2)'="C-",'$D(ZTQUEUED) D ^%ZISC
D HOME^%ZIS
Q
;ENY2K5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2K5 7169 printed Nov 22, 2024@17:07:25 Page 2
ENY2K5 ;(WASH ISC)/DH-Generate Y2K Work Orders ;7.15.99
+1 ;;7.0;ENGINEERING;**51,55,59,61**;Aug 17, 1993
+2 ; Creates or finds work orders for a specified Y2K worklist
+3 ; and then makes calls to print that document
+4 ; Global ^TMP($J,"ENY2"... contains sort order and equip entry numbers
+5 ;
+6 ; ENTECH indicates whether 'sort by tech' is in effect
+7 ; TECH => IEN for Engineering Employee file
+8 ; (0 => tech is undefined)
+9 ; ENEMP => employee name as character string (could be "UNASSIGNED")
+10 ;
PR ; Begin
+1 IF '$DATA(^TMP($JOB,"ENY2"))
Begin DoDot:1
+2 WRITE !!,"A Y2K Worklist was requested, but there's nothing to print."
+3 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
WRITE !,?5,"Run time: "_Y
+4 WRITE !,?5,"Shop: "_$SELECT(ENSHKEY("SEL")="ALL":"ALL",1:$PIECE(^DIC(6922,ENSHKEY("SEL"),0),U))
+5 WRITE !,?5,"Estimated Y2K Compliance Date: "_ENY2DT("E")
End DoDot:1
QUIT
+6 NEW I,J,K,X,X1,EN,ENX,TECH,DA,DIC,DIE
+7 NEW H,W,SE,MULT,NODE,HDR,LINE,TIME,VACANT,SHOP
+8 IF IOM>93
SET HDR="HDR96^ENY2K6"
SET LINE="LN96^ENY2K7"
+9 IF '$TEST
SET HDR="HDR80^ENY2K6"
SET LINE="LN80^ENY2K7"
+10 DO NOW^%DTC
SET Y=%
SET ENDATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_($EXTRACT(Y,1,3)+1700)
+11 IF HDR="HDR96^ENY2K6"
XECUTE ^DD("DD")
SET TIME=$PIECE(Y,":",1,2)
+12 SET (TECH,ENPG,ENY)=0
SET ENEXPAND=1
+13 USE IO
SET X=""
+14 SET NODE="^TMP($J,""ENY2"",0)"
SET NODE=$QUERY(@NODE)
SET SUB=$QLENGTH(NODE)
+15 SET ENSHKEY=0
SET ENSHKEY(0)=$ORDER(^TMP($JOB,"ENY2",0))
KILL ENXP
+16 FOR
if $GET(X)="^"
QUIT
SET ENSHKEY=$ORDER(^TMP($JOB,"ENY2",ENSHKEY))
if ENSHKEY'=ENSHKEY(0)
DO COMP
if ENSHKEY=""
DO HOLD
if 'ENSHKEY!($GET(X)="^")
QUIT
if ENTECH'=0
SET ENEMP=$ORDER(^TMP($JOB,"ENY2",ENSHKEY,""))
SET DA=$QSUBSCRIPT(NODE,SUB)
SET ENHZ=@NODE
DO PR1
+17 IF $DATA(ENXP("LOCK"))
WRITE !!,"Abnormal termination. This worklist may be incomplete."
HANG 5
+18 DO TRLR
+19 ;Design EXIT
GOTO OUT
+20 ;
PR1 SET ENSHOP=$PIECE(^DIC(6922,ENSHKEY,0),U,1)
SET ENSHABR=$PIECE(^(0),U,2)
SET ENCODE="Y2-"_ENSHABR_$EXTRACT(DT,2,5)
SET X=""
+1 SET ENWO=$ORDER(^ENG(6920,"B",ENCODE_"-9999"),-1)
+2 IF ENWO'[ENCODE
SET ENWO=ENCODE_"-001"
+3 IF '$TEST
SET J=$PIECE(ENWO,"-",3)+1
SET J=$SELECT($LENGTH(J)=1:"00"_J,$LENGTH(J)=2:"0"_J,1:J)
SET $PIECE(ENWO,"-",3)=J
+4 ;
+5 ;Worklist without RESP TECH
IF ENTECH=0
Begin DoDot:1
+6 DO TRLR
DO @HDR
SET ENPG(0)=ENPG
FOR
if $GET(X)="^"
QUIT
DO PR2
if $GET(X)="^"
QUIT
SET NODE=$QUERY(@NODE)
if $QSUBSCRIPT(NODE,3)'=ENSHKEY
QUIT
SET DA=$QSUBSCRIPT(NODE,SUB)
SET ENHZ=@NODE
if DA'>0
QUIT
End DoDot:1
QUIT
+7 ;
+8 ;With RESP TECH (may or may not be sorted by tech)
DO EMP
+9 DO TRLR
DO @HDR
SET ENPG(0)=ENPG
FOR
if $GET(X)="^"
QUIT
DO PR2
if $GET(X)="^"
QUIT
SET NODE=$QUERY(@NODE)
if $QSUBSCRIPT(NODE,3)'=ENSHKEY
QUIT
Begin DoDot:1
+10 IF $QSUBSCRIPT(NODE,4)'=ENEMP
SET ENEMP=$QSUBSCRIPT(NODE,4)
DO EMP
DO TRLR
DO @HDR
SET ENPG(0)=ENPG
+11 SET DA=$QSUBSCRIPT(NODE,SUB)
SET ENHZ=@NODE
End DoDot:1
if DA'>0
QUIT
+12 ;Return to design EXIT
QUIT
+13 ;
PR2 ; need a work order?
+1 if '$DATA(^ENG(6914,DA,11))
QUIT
SET ENWOX=""
SET ENWO("P")=$PIECE(^ENG(6914,DA,11),U,8)
SET ENWO("T")=$PIECE(^(11),U,9)
+2 IF ENWO("T")]""
Begin DoDot:1
+3 SET J=0
FOR
SET J=$ORDER(^ENG(6914,DA,6,J))
if J'>0
QUIT
IF $PIECE(^ENG(6914,DA,6,J,0),U,2)=ENWO("T")
SET ENWOX="COMPLETE"
QUIT
End DoDot:1
+4 ; devices with completed Y2K work orders will not appear on worklist (don't need another work order)
IF ENWOX="COMPLETE"
SET ^TMP($JOB,"ENY2","COMP",DA)=ENWO("T")
QUIT
+5 IF ENWO("P")>0
IF $DATA(^ENG(6920,ENWO("P"),0))
SET ENWOX=ENWO("T")
Begin DoDot:1
+6 ; wo exists, but is disapproved
IF $PIECE($GET(^ENG(6920,ENWO("P"),4)),U,3)=5
SET ^TMP($JOB,"ENY2","COMP",DA)=ENWO("T")
QUIT
+7 ; use existing Y2K work order
DO PR3
End DoDot:1
QUIT
+8 IF ENWO("T")]""
SET ENWO=ENWO("T")
DO PR22
DO PR3
QUIT
+9 DO PR22
DO PR3
+10 ;back to program segment PR1
QUIT
+11 ;
PR22 ; must create a new work order from the top
+1 ; ENWO as set in line PR1+1 or from ENWO("T")
+2 LOCK +^ENG(6920,"B"):20
IF '$TEST
SET ENXP("LOCK")=1
QUIT
+3 ;
PR221 IF $DATA(^ENG(6920,"B",ENWO))
SET J=$PIECE(ENWO,"-",3)+1
SET J=$SELECT($LENGTH(J)=1:"00"_J,$LENGTH(J)=2:"0"_J,1:J)
SET ENWO=$PIECE(ENWO,"-",1,2)_"-"_J
GOTO PR221
+1 IF ENWO("T")=""
IF $DATA(^ENG(6914,"AL",ENWO))
SET J=$PIECE(ENWO,"-",3)+1
SET J=$SELECT($LENGTH(J)=1:"00"_J,$LENGTH(J)=2:"0"_J,1:J)
SET ENWO=$PIECE(ENWO,"-",1,2)_"-"_J
GOTO PR221
+2 SET (X,ENWOX)=ENWO
+3 ;
PR222 ; create a work order when you already have the number
+1 KILL DD,DO
SET DIC="^ENG(6920,"
SET DIC(0)="LX"
SET X=ENWO
DO FILE^DICN
SET ENNXL=+Y
+2 if ENNXL>0
LOCK +^ENG(6920,ENNXL):1
+3 LOCK -^ENG(6920,"B")
+4 IF ENNXL'>0
SET ENXP("LOCK")=1
QUIT
+5 SET $PIECE(^ENG(6914,DA,11),U,8)=ENNXL
SET $PIECE(^(11),U,9)=ENWO
SET ^ENG(6914,"AL",ENWO,DA)=""
+6 SET $PIECE(^ENG(6920,ENNXL,0),U,2)=DT
SET $PIECE(^(0),U,6)=ENWO
SET $PIECE(^ENG(6920,ENNXL,3),U,8)=DA
SET ^ENG(6920,"G",DA,ENNXL)=""
SET ^ENG(6920,ENNXL,2)=ENSHKEY
+7 SET X(1)=$ORDER(^ENG(6920.1,"B","Y2K COMPLIANCE",0))
+8 IF X(1)>0
IF $DATA(^ENG(6920.1,X(1),0))
SET ^ENG(6920,ENNXL,8,0)="^6920.035PA^1^1"
SET ^ENG(6920,ENNXL,8,1,0)=X(1)
+9 IF $DATA(^ENG(6914,DA,3))
SET EN=^(3)
SET ENPMN=$PIECE(EN,U,6)
SET ENLOC=$PIECE(EN,U,5)
if ENPMN]""
SET $PIECE(^ENG(6920,ENNXL,3),U)=ENPMN
SET ^ENG(6920,"E",ENPMN,ENNXL)=""
IF ENLOC]""
IF ENLOC?.N
SET $PIECE(^ENG(6920,ENNXL,0),U,4)=ENLOC
SET ^ENG(6920,"C",ENLOC,ENNXL)=""
+10 ; work performed
SET $PIECE(^ENG(6920,ENNXL,5),U,7)=$SELECT($PIECE(^ENG(6914,DA,11),U,12)]"":$PIECE(^(11),U,12),1:"YEAR 2000 compliance.")
+11 ; ENEMP not included in input global
IF ENTECH=0
Begin DoDot:1
+12 SET TECH=$PIECE(^ENG(6914,DA,11),U,5)
if TECH=""
SET TECH=0
IF TECH>0
if '$DATA(^ENG("EMP",TECH,0))
SET TECH=0
+13 if TECH>0
SET ENEMP=$PIECE(^ENG("EMP",TECH,0),U)
End DoDot:1
+14 ;Set ASSIGNED and RESPONSIBLE TECH
IF TECH>0
Begin DoDot:1
+15 SET $PIECE(^ENG(6920,ENNXL,2),U,2)=TECH
+16 SET SHOP=$SELECT($PIECE(^ENG(6914,DA,11),U,7)]"":$PIECE(^(11),U,7),$PIECE(^ENG("EMP",TECH,0),U,10)]"":$PIECE(^(0),U,10),1:"")
+17 SET ^ENG(6920,ENNXL,7,0)="^6920.02PA^1^1"
SET ^ENG(6920,ENNXL,7,1,0)=TECH_"^^"_SHOP
End DoDot:1
+18 SET ENDA=DA
SET DA=ENNXL
DO TEST^ENWOCOMP
+19 IF ENEXPAND
DO ST^ENWOINV
SET DIE="^ENG(6920,"
SET DR="6///^S X=""Year 2000 compliance."""
DO ^DIE
+20 SET DA=ENDA
+21 IF $PIECE(EN,U,2)]""!($PIECE(EN,U,3)]"")
DO WOCST
+22 LOCK -^ENG(6920,ENNXL)
+23 ;increment in preparation for next hit
SET K=$PIECE(ENWO,"-",3)
SET K=K+1
SET K=$SELECT($LENGTH(K)=1:"00"_K,$LENGTH(K)=2:"0"_K,1:K)
SET ENWO=$PIECE(ENWO,"-",1,2)_"-"_K
+24 QUIT
+25 ;
PR3 ; do the printing
+1 IF ENY+12>IOSL
DO TRLR
DO @HDR
if $GET(X)="^"
QUIT
+2 DO @LINE
+3 QUIT
+4 ;
EMP SET VACANT=0
IF ENEMP=0
SET TECH=0
QUIT
+1 SET TECH=$ORDER(^ENG("EMP","B",ENEMP,0))
IF TECH'>0
SET TECH=0
QUIT
+2 IF '$DATA(^ENG("EMP",TECH,0))
SET (TECH,ENEMP)=0
QUIT
+3 if $PIECE(^ENG("EMP",TECH,0),U,7)="V"
SET VACANT=1
+4 QUIT
+5 ;
WOCST QUIT
+1 ;
HOLD IF $GET(ENPG(0))>0
IF ENPG=ENPG(0)
IF ENY'>7
WRITE !!,"There are no incomplete Y2K work orders to print.",!
+1 IF $EXTRACT(IOST,1,2)="C-"
READ !,"Press <RETURN> to continue, '^' to escape...",X:DTIME
if '$TEST
SET X=U
+2 QUIT
+3 ;
TRLR ; Interpret PM STATUS and CONDITION CODE
+1 IF ENPG
IF ($EXTRACT(IOST,1,2)'="C-"!($DATA(IO("S"))))
Begin DoDot:1
+2 FOR
if $Y>(IOSL-4)
QUIT
WRITE !
+3 KILL K
SET $PIECE(K,"-",(IOM-1))="-"
WRITE K
KILL K
+4 WRITE !,"FC=>Y2K compliant NC=>Y2K non-compliant NA=>Not applicable (no Y2K issues)"
+5 WRITE !,"CNL=>Could not locate TI=>Turned-in"
End DoDot:1
+6 QUIT
+7 ;
COMP ; devices with completed Y2K work orders (exception messages)
+1 ; no exceptions
if '$DATA(^TMP($JOB,"ENY2","COMP"))
QUIT
+2 SET ENPG=ENPG+1
DO HOLD
+3 WRITE @IOF,"DEVICES WITH COMPLETED Y2K WORK ORDERS "_ENDATE_" Page "_ENPG
+4 WRITE !!,"The following device(s) have a Y2K CATEGORY of CONDITIONALLY COMPLIANT and",!,"yet their Y2K work order(s) are complete. They are not being printed on",!,"this Y2K worklist."
+5 WRITE !!,"You should probably use the 'Manual Equipment Selection for Y2K' option to",!,"change their Y2K CATEGORY to COMPLIANT."
+6 KILL X
SET $PIECE(X,"-",(IOM-2))="-"
WRITE !,X,!
+7 SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,"ENY2","COMP",DA))
if 'DA
QUIT
WRITE !,?10,DA,?25,"("_^TMP($JOB,"ENY2","COMP",DA)_")"
+8 KILL ^TMP($JOB,"ENY2","COMP")
+9 QUIT
+10 ;
OUT KILL ENSHABR,ENCODE,ENWO,ENWOX,ENTECH,ENSRT,ENPG,ENY,ENPMN,ENID,ENMAN,ENMANF,ENMOD,ENSN,ENLID,ENLOC,ENPRC,ENPROC,ENDTYP,ENDVTYP,ENUSE,ENDA
+1 KILL ENHZ,ENLVL,ENEMP,ENNXL,ENNXT,ENSTAT,ENFNO,ENSRVC,ENWING,ENHRS,ENMAT,ENEXPAND,ENCOND,ENX,ENMFGR,ENLABOR,ENDATE
+2 KILL ^TMP($JOB)
+3 IF $EXTRACT(IOST,1,2)'="C-"
IF '$DATA(ZTQUEUED)
DO ^%ZISC
+4 DO HOME^%ZIS
+5 QUIT
+6 ;ENY2K5
