Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ENY2K5

ENY2K5.m

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