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

ENY2K3.m

Go to the documentation of this file. 
  1. ENY2K3 ;(WASH ISC)/DH-Select Equipment for Y2K Worklist ;5.19.98
  1.  ;;7.0;ENGINEERING;**51**;Aug 17, 1993
  1.  ;  called by ENY2K2
  1. ENTRY ;  select IENs for Y2K worklist
  1.  ;  store in ^TMP($J,
  1.  K ^TMP($J) N NODE,SUB
  1.  S X=$$UP^XLFSTR($E($P($G(^DIC(6922,35,0)),U),1,10)) I X["BIO" S ENY2K("BME")=35
  1.  I '$G(ENY2K("BME")) D
  1.  . S DA=0 F  S DA=$O(^DIC(6922,DA)) Q:'DA!($G(ENY2K("BME")))  S X=$$UP^XLFSTR($E($P(^(DA,0),U),1,10)) I X["BIO" S ENY2K("BME")=DA
  1.  I '$G(ENY2K("BME")) W !!,"Cannot find the BIOMEDICAL ENGINEERING shop. Can't proceed.",*7 G OUT
  1.  S ENSHKEY("SEL")=ENSHKEY
  1.  I ENSHKEY'="ALL" D
  1.  . S DA=0 F  S DA=$O(^ENG(6914,"AK","CC",DA)) Q:'DA  D
  1.  .. Q:'$D(^ENG(6914,DA,11))  S X=^(11)
  1.  .. Q:$P(X,U,2)>ENY2DT  ;check estimated compliance date
  1.  .. I $P(X,U,7)=ENSHKEY S ^TMP($J,ENSHKEY,DA)="" Q
  1.  .. I $P(X,U,7)="" D
  1.  ... S X(1)=$O(^ENG(6914,DA,4,0)) I X(1)>0 S X(2)=$P(^(X(1),0),U) S:X(2)=ENSHKEY ^TMP($J,ENSHKEY,DA)="" Q
  1.  ... I ENSHKEY=ENY2K("BME") S ^TMP($J,ENSHKEY,DA)=""
  1.  I ENSHKEY="ALL" D
  1.  . S DA=0 F  S DA=$O(^ENG(6914,"AK","CC",DA)) Q:'DA  D
  1.  .. Q:'$D(^ENG(6914,DA,11))  S X=^(11)
  1.  .. Q:$P(X,U,2)>ENY2DT  ;check estimated compliance date
  1.  .. I $P(X,U,7) S ^TMP($J,$P(X,U,7),DA)="" Q
  1.  .. S X(1)=$O(^ENG(6914,DA,4,0)) I X(1)>0 S X(2)=$P(^(X(1),0),U),^TMP($J,X(2),DA)="" Q
  1.  .. S ^TMP($J,ENY2K("BME"),DA)=""
  1.  D LST2,PR^ENY2K5
  1.  G OUT
  1.  ;
  1. LST2 N EN,A,B,C,X,TAG
  1.  S ENSHKEY=0 F  S ENSHKEY=$O(^TMP($J,ENSHKEY)) Q:'ENSHKEY  S DA=0 F  S DA=$O(^TMP($J,ENSHKEY,DA)) Q:'DA  D LST3
  1.  Q
  1.  ;
  1. LST3 S X=$P($G(^ENG(6914,DA,3)),U) I "^4^5^"[(U_X_U) Q  ;check use status
  1.  I 'ENSRT("OOS"),X=2 Q  ;is OUT OF SERVICE an issue?
  1.  S EN("NEXT")="A" F X="A","B","C" S @X=""
  1.  I 'ENTECH("ALL"),$P(^ENG(6914,DA,11),U,5)'=ENTECH Q  ;check for assigned tech
  1.  S X=$P(^ENG(6914,DA,11),U,5) I X>0 D
  1.  . I $D(^ENG("EMP",X,0)) S X(1)=""""_$P(^(0),U)_"""" Q
  1.  . S X(1)=""""_"DELETED"_""""
  1.  I X'>0 S X(1)=""""_"UNASSIGNED"_""""
  1.  S @EN("NEXT")=X(1)
  1.  S EN("NEXT")=$C($A(EN("NEXT"))+1)
  1.  S TAG="LST"_ENSRT D @TAG Q:$G(X)=-1
  1.  S SUB="" F X(1)="A","B","C" Q:$G(@X(1))=""  S SUB=SUB_@X(1)_","
  1.  D BLD
  1.  Q
  1.  ;
  1. LSTE ;  By ENTRY NUMBER
  1.  I ENSRT("ALL") Q
  1.  I ENSRT("FR")]DA!(DA]ENSRT("TO")) S X=-1
  1.  Q
  1. LSTP ;  By PM NUMBER
  1.  S X(1)=$P($G(^ENG(6914,DA,3)),U,6) S:X(1)="" X(1)=0
  1.  S:X(1)'=0 X(1)=""""_X(1)_""""
  1.  S @EN("NEXT")=X(1)
  1.  Q
  1. LSTI ;  By LOCAL ID
  1.  S X(1)=$P($G(^ENG(6914,DA,3)),U,7) S:X(1)="" X(1)=0
  1.  S X(2)=$S(X(1)?.N:X(1),1:""""_X(1)_"""")
  1.  I ENSRT("ALL") S @EN("NEXT")=X(2),EN("NEXT")=$C($A(EN("NEXT"))+1)
  1.  E  S X="" D
  1.  . I ENSRT("FR")]X(1)!(X(1)]ENSRT("TO")) S X=-1 Q
  1.  . S @EN("NEXT")=X(2),EN("NEXT")=$C($A(EN("NEXT"))+1)
  1.  I ENSRT("LOC"),$G(X)'=-1 D
  1.  . S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
  1.  . I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
  1.  .. S X(1)=""""_$P(X(1),U,2)_""""
  1.  .. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
  1.  . I $P(X(1),U)=-2 S X=-1 Q
  1.  . I X(1)=-3,ENSRT("LOC","ALL") D
  1.  .. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
  1.  . I X(1)=-3 S X=-1 Q
  1.  . S @EN("NEXT")=X(1)
  1.  Q
  1. LSTL ;  By LOCATION
  1.  S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
  1.  I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
  1.  . S X(1)=""""_$P(X(1),U,2)_""""
  1.  . F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
  1.  I $P(X(1),U)=-2 S X=-1 Q
  1.  I X(1)=-3,ENSRT("LOC","ALL") D
  1.  . S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
  1.  I X(1)=-3 S X=-1 Q
  1.  S @EN("NEXT")=X(1)
  1.  Q
  1. LSTC ;  By EQUIPMENT CATEGORY
  1.  S X(2)=$P($G(^ENG(6914,DA,1)),U) S:X(2)="" X(1)=0
  1.  I X(2)>0 S X(1)=$P($G(^ENG(6911,X(2),0)),U) S:X(1)="" X(1)=0
  1.  S:X(1)'?.N X(1)=""""_X(1)_""""
  1.  I 'ENSRT("ALL"),X(2)'=ENSRT("FR") S X=-1 Q
  1.  S @EN("NEXT")=X(1),EN("NEXT")=$C($A(EN("NEXT"))+1)
  1.  I ENSRT("LOC") D
  1.  . S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
  1.  . I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
  1.  .. S X(1)=""""_$P(X(1),U,2)_""""
  1.  .. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
  1.  . I $P(X(1),U)=-2 S X=-1 Q
  1.  . I X(1)=-3,ENSRT("LOC","ALL") D
  1.  .. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
  1.  . I X(1)=-3 S X=-1 Q
  1.  . S @EN("NEXT")=X(1)
  1.  Q
  1. LSTS ;  By OWNING SERVICE
  1.  S X(2)=$P($G(^ENG(6914,DA,3)),U,2) S:X(2)="" X(1)=0
  1.  I X(2)>0 S X(1)=$P($G(^DIC(49,X(2),0)),U) S:X(1)="" X(1)=0
  1.  S:X(1)'?.N X(1)=""""_X(1)_""""
  1.  I 'ENSRT("ALL"),X(2)'=ENSRT("FR") S X=-1 Q
  1.  S @EN("NEXT")=X(1),EN("NEXT")=$C($A(EN("NEXT"))+1)
  1.  I ENSRT("LOC") D
  1.  . S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
  1.  . I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
  1.  .. S X(1)=""""_$P(X(1),U,2)_""""
  1.  .. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
  1.  . I $P(X(1),U)=-2 S X=-1 Q
  1.  . I X(1)=-3,ENSRT("LOC","ALL") D
  1.  .. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
  1.  . I X(1)=-3 S X=-1 Q
  1.  . S @EN("NEXT")=X(1)
  1.  Q
  1.  ;
  1. BLD ;   build ^TMP global from which to print Y2K worklist
  1.  S NODE="^TMP($J,""ENY2"","_ENSHKEY_","_SUB_DA_")"
  1.  S @NODE=""
  1.  Q
  1.  ;
  1. OUT K K,S,ENPM,ENPMDT,ENA,ENHZS,ENPMWK,ENSHOP,ENSHKEY,ENPMMN,ENSTMN,ENSTYR,ENCRIT,ENSRT,ENTECH,ENY,ENERR,ENMN,ENMNTH,ENI,ENLID
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;ENY2K3