ENY2K3 ;(WASH ISC)/DH-Select Equipment for Y2K Worklist ;5.19.98
;;7.0;ENGINEERING;**51**;Aug 17, 1993
; called by ENY2K2
ENTRY ; select IENs for Y2K worklist
; store in ^TMP($J,
K ^TMP($J) N NODE,SUB
S X=$$UP^XLFSTR($E($P($G(^DIC(6922,35,0)),U),1,10)) I X["BIO" S ENY2K("BME")=35
I '$G(ENY2K("BME")) D
. 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
I '$G(ENY2K("BME")) W !!,"Cannot find the BIOMEDICAL ENGINEERING shop. Can't proceed.",*7 G OUT
S ENSHKEY("SEL")=ENSHKEY
I ENSHKEY'="ALL" D
. S DA=0 F S DA=$O(^ENG(6914,"AK","CC",DA)) Q:'DA D
.. Q:'$D(^ENG(6914,DA,11)) S X=^(11)
.. Q:$P(X,U,2)>ENY2DT ;check estimated compliance date
.. I $P(X,U,7)=ENSHKEY S ^TMP($J,ENSHKEY,DA)="" Q
.. I $P(X,U,7)="" D
... 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
... I ENSHKEY=ENY2K("BME") S ^TMP($J,ENSHKEY,DA)=""
I ENSHKEY="ALL" D
. S DA=0 F S DA=$O(^ENG(6914,"AK","CC",DA)) Q:'DA D
.. Q:'$D(^ENG(6914,DA,11)) S X=^(11)
.. Q:$P(X,U,2)>ENY2DT ;check estimated compliance date
.. I $P(X,U,7) S ^TMP($J,$P(X,U,7),DA)="" Q
.. 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
.. S ^TMP($J,ENY2K("BME"),DA)=""
D LST2,PR^ENY2K5
G OUT
;
LST2 N EN,A,B,C,X,TAG
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
Q
;
LST3 S X=$P($G(^ENG(6914,DA,3)),U) I "^4^5^"[(U_X_U) Q ;check use status
I 'ENSRT("OOS"),X=2 Q ;is OUT OF SERVICE an issue?
S EN("NEXT")="A" F X="A","B","C" S @X=""
I 'ENTECH("ALL"),$P(^ENG(6914,DA,11),U,5)'=ENTECH Q ;check for assigned tech
S X=$P(^ENG(6914,DA,11),U,5) I X>0 D
. I $D(^ENG("EMP",X,0)) S X(1)=""""_$P(^(0),U)_"""" Q
. S X(1)=""""_"DELETED"_""""
I X'>0 S X(1)=""""_"UNASSIGNED"_""""
S @EN("NEXT")=X(1)
S EN("NEXT")=$C($A(EN("NEXT"))+1)
S TAG="LST"_ENSRT D @TAG Q:$G(X)=-1
S SUB="" F X(1)="A","B","C" Q:$G(@X(1))="" S SUB=SUB_@X(1)_","
D BLD
Q
;
LSTE ; By ENTRY NUMBER
I ENSRT("ALL") Q
I ENSRT("FR")]DA!(DA]ENSRT("TO")) S X=-1
Q
LSTP ; By PM NUMBER
S X(1)=$P($G(^ENG(6914,DA,3)),U,6) S:X(1)="" X(1)=0
S:X(1)'=0 X(1)=""""_X(1)_""""
S @EN("NEXT")=X(1)
Q
LSTI ; By LOCAL ID
S X(1)=$P($G(^ENG(6914,DA,3)),U,7) S:X(1)="" X(1)=0
S X(2)=$S(X(1)?.N:X(1),1:""""_X(1)_"""")
I ENSRT("ALL") S @EN("NEXT")=X(2),EN("NEXT")=$C($A(EN("NEXT"))+1)
E S X="" D
. I ENSRT("FR")]X(1)!(X(1)]ENSRT("TO")) S X=-1 Q
. S @EN("NEXT")=X(2),EN("NEXT")=$C($A(EN("NEXT"))+1)
I ENSRT("LOC"),$G(X)'=-1 D
. S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
. I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
.. S X(1)=""""_$P(X(1),U,2)_""""
.. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
. I $P(X(1),U)=-2 S X=-1 Q
. I X(1)=-3,ENSRT("LOC","ALL") D
.. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
. I X(1)=-3 S X=-1 Q
. S @EN("NEXT")=X(1)
Q
LSTL ; By LOCATION
S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
. S X(1)=""""_$P(X(1),U,2)_""""
. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
I $P(X(1),U)=-2 S X=-1 Q
I X(1)=-3,ENSRT("LOC","ALL") D
. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
I X(1)=-3 S X=-1 Q
S @EN("NEXT")=X(1)
Q
LSTC ; By EQUIPMENT CATEGORY
S X(2)=$P($G(^ENG(6914,DA,1)),U) S:X(2)="" X(1)=0
I X(2)>0 S X(1)=$P($G(^ENG(6911,X(2),0)),U) S:X(1)="" X(1)=0
S:X(1)'?.N X(1)=""""_X(1)_""""
I 'ENSRT("ALL"),X(2)'=ENSRT("FR") S X=-1 Q
S @EN("NEXT")=X(1),EN("NEXT")=$C($A(EN("NEXT"))+1)
I ENSRT("LOC") D
. S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
. I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
.. S X(1)=""""_$P(X(1),U,2)_""""
.. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
. I $P(X(1),U)=-2 S X=-1 Q
. I X(1)=-3,ENSRT("LOC","ALL") D
.. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
. I X(1)=-3 S X=-1 Q
. S @EN("NEXT")=X(1)
Q
LSTS ; By OWNING SERVICE
S X(2)=$P($G(^ENG(6914,DA,3)),U,2) S:X(2)="" X(1)=0
I X(2)>0 S X(1)=$P($G(^DIC(49,X(2),0)),U) S:X(1)="" X(1)=0
S:X(1)'?.N X(1)=""""_X(1)_""""
I 'ENSRT("ALL"),X(2)'=ENSRT("FR") S X=-1 Q
S @EN("NEXT")=X(1),EN("NEXT")=$C($A(EN("NEXT"))+1)
I ENSRT("LOC") D
. S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
. I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
.. S X(1)=""""_$P(X(1),U,2)_""""
.. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
. I $P(X(1),U)=-2 S X=-1 Q
. I X(1)=-3,ENSRT("LOC","ALL") D
.. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
. I X(1)=-3 S X=-1 Q
. S @EN("NEXT")=X(1)
Q
;
BLD ; build ^TMP global from which to print Y2K worklist
S NODE="^TMP($J,""ENY2"","_ENSHKEY_","_SUB_DA_")"
S @NODE=""
Q
;
OUT K K,S,ENPM,ENPMDT,ENA,ENHZS,ENPMWK,ENSHOP,ENSHKEY,ENPMMN,ENSTMN,ENSTYR,ENCRIT,ENSRT,ENTECH,ENY,ENERR,ENMN,ENMNTH,ENI,ENLID
S:$D(ZTQUEUED) ZTREQ="@"
Q
;ENY2K3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2K3 4949 printed Sep 23, 2025@19:33:17 Page 2
ENY2K3 ;(WASH ISC)/DH-Select Equipment for Y2K Worklist ;5.19.98
+1 ;;7.0;ENGINEERING;**51**;Aug 17, 1993
+2 ; called by ENY2K2
ENTRY ; select IENs for Y2K worklist
+1 ; store in ^TMP($J,
+2 KILL ^TMP($JOB)
NEW NODE,SUB
+3 SET X=$$UP^XLFSTR($EXTRACT($PIECE($GET(^DIC(6922,35,0)),U),1,10))
IF X["BIO"
SET ENY2K("BME")=35
+4 IF '$GET(ENY2K("BME"))
Begin DoDot:1
+5 SET DA=0
FOR
SET DA=$ORDER(^DIC(6922,DA))
if 'DA!($GET(ENY2K("BME")))
QUIT
SET X=$$UP^XLFSTR($EXTRACT($PIECE(^(DA,0),U),1,10))
IF X["BIO"
SET ENY2K("BME")=DA
End DoDot:1
+6 IF '$GET(ENY2K("BME"))
WRITE !!,"Cannot find the BIOMEDICAL ENGINEERING shop. Can't proceed.",*7
GOTO OUT
+7 SET ENSHKEY("SEL")=ENSHKEY
+8 IF ENSHKEY'="ALL"
Begin DoDot:1
+9 SET DA=0
FOR
SET DA=$ORDER(^ENG(6914,"AK","CC",DA))
if 'DA
QUIT
Begin DoDot:2
+10 if '$DATA(^ENG(6914,DA,11))
QUIT
SET X=^(11)
+11 ;check estimated compliance date
if $PIECE(X,U,2)>ENY2DT
QUIT
+12 IF $PIECE(X,U,7)=ENSHKEY
SET ^TMP($JOB,ENSHKEY,DA)=""
QUIT
+13 IF $PIECE(X,U,7)=""
Begin DoDot:3
+14 SET X(1)=$ORDER(^ENG(6914,DA,4,0))
IF X(1)>0
SET X(2)=$PIECE(^(X(1),0),U)
if X(2)=ENSHKEY
SET ^TMP($JOB,ENSHKEY,DA)=""
QUIT
+15 IF ENSHKEY=ENY2K("BME")
SET ^TMP($JOB,ENSHKEY,DA)=""
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF ENSHKEY="ALL"
Begin DoDot:1
+17 SET DA=0
FOR
SET DA=$ORDER(^ENG(6914,"AK","CC",DA))
if 'DA
QUIT
Begin DoDot:2
+18 if '$DATA(^ENG(6914,DA,11))
QUIT
SET X=^(11)
+19 ;check estimated compliance date
if $PIECE(X,U,2)>ENY2DT
QUIT
+20 IF $PIECE(X,U,7)
SET ^TMP($JOB,$PIECE(X,U,7),DA)=""
QUIT
+21 SET X(1)=$ORDER(^ENG(6914,DA,4,0))
IF X(1)>0
SET X(2)=$PIECE(^(X(1),0),U)
SET ^TMP($JOB,X(2),DA)=""
QUIT
+22 SET ^TMP($JOB,ENY2K("BME"),DA)=""
End DoDot:2
End DoDot:1
+23 DO LST2
DO PR^ENY2K5
+24 GOTO OUT
+25 ;
LST2 NEW EN,A,B,C,X,TAG
+1 SET ENSHKEY=0
FOR
SET ENSHKEY=$ORDER(^TMP($JOB,ENSHKEY))
if 'ENSHKEY
QUIT
SET DA=0
FOR
SET DA=$ORDER(^TMP($JOB,ENSHKEY,DA))
if 'DA
QUIT
DO LST3
+2 QUIT
+3 ;
LST3 ;check use status
SET X=$PIECE($GET(^ENG(6914,DA,3)),U)
IF "^4^5^"[(U_X_U)
QUIT
+1 ;is OUT OF SERVICE an issue?
IF 'ENSRT("OOS")
IF X=2
QUIT
+2 SET EN("NEXT")="A"
FOR X="A","B","C"
SET @X=""
+3 ;check for assigned tech
IF 'ENTECH("ALL")
IF $PIECE(^ENG(6914,DA,11),U,5)'=ENTECH
QUIT
+4 SET X=$PIECE(^ENG(6914,DA,11),U,5)
IF X>0
Begin DoDot:1
+5 IF $DATA(^ENG("EMP",X,0))
SET X(1)=""""_$PIECE(^(0),U)_""""
QUIT
+6 SET X(1)=""""_"DELETED"_""""
End DoDot:1
+7 IF X'>0
SET X(1)=""""_"UNASSIGNED"_""""
+8 SET @EN("NEXT")=X(1)
+9 SET EN("NEXT")=$CHAR($ASCII(EN("NEXT"))+1)
+10 SET TAG="LST"_ENSRT
DO @TAG
if $GET(X)=-1
QUIT
+11 SET SUB=""
FOR X(1)="A","B","C"
if $GET(@X(1))=""
QUIT
SET SUB=SUB_@X(1)_","
+12 DO BLD
+13 QUIT
+14 ;
LSTE ; By ENTRY NUMBER
+1 IF ENSRT("ALL")
QUIT
+2 IF ENSRT("FR")]DA!(DA]ENSRT("TO"))
SET X=-1
+3 QUIT
LSTP ; By PM NUMBER
+1 SET X(1)=$PIECE($GET(^ENG(6914,DA,3)),U,6)
if X(1)=""
SET X(1)=0
+2 if X(1)'=0
SET X(1)=""""_X(1)_""""
+3 SET @EN("NEXT")=X(1)
+4 QUIT
LSTI ; By LOCAL ID
+1 SET X(1)=$PIECE($GET(^ENG(6914,DA,3)),U,7)
if X(1)=""
SET X(1)=0
+2 SET X(2)=$SELECT(X(1)?.N:X(1),1:""""_X(1)_"""")
+3 IF ENSRT("ALL")
SET @EN("NEXT")=X(2)
SET EN("NEXT")=$CHAR($ASCII(EN("NEXT"))+1)
+4 IF '$TEST
SET X=""
Begin DoDot:1
+5 IF ENSRT("FR")]X(1)!(X(1)]ENSRT("TO"))
SET X=-1
QUIT
+6 SET @EN("NEXT")=X(2)
SET EN("NEXT")=$CHAR($ASCII(EN("NEXT"))+1)
End DoDot:1
+7 IF ENSRT("LOC")
IF $GET(X)'=-1
Begin DoDot:1
+8 SET X(1)=$$LOC^ENEQPMS8(DA)
IF X(1)=-1
SET X=-1
QUIT
+9 IF $PIECE(X(1),U)=-2
IF ENSRT("LOC","ALL")
Begin DoDot:2
+10 SET X(1)=""""_$PIECE(X(1),U,2)_""""
+11 FOR J=1:1:($LENGTH(ENSRT("BY"))-1)
SET X(1)="0,"_X(1)
End DoDot:2
+12 IF $PIECE(X(1),U)=-2
SET X=-1
QUIT
+13 IF X(1)=-3
IF ENSRT("LOC","ALL")
Begin DoDot:2
+14 SET X(1)=0
FOR J=1:1:($LENGTH(ENSRT("BY"))-1)
SET X(1)="0,"_X(1)
End DoDot:2
+15 IF X(1)=-3
SET X=-1
QUIT
+16 SET @EN("NEXT")=X(1)
End DoDot:1
+17 QUIT
LSTL ; By LOCATION
+1 SET X(1)=$$LOC^ENEQPMS8(DA)
IF X(1)=-1
SET X=-1
QUIT
+2 IF $PIECE(X(1),U)=-2
IF ENSRT("LOC","ALL")
Begin DoDot:1
+3 SET X(1)=""""_$PIECE(X(1),U,2)_""""
+4 FOR J=1:1:($LENGTH(ENSRT("BY"))-1)
SET X(1)="0,"_X(1)
End DoDot:1
+5 IF $PIECE(X(1),U)=-2
SET X=-1
QUIT
+6 IF X(1)=-3
IF ENSRT("LOC","ALL")
Begin DoDot:1
+7 SET X(1)=0
FOR J=1:1:($LENGTH(ENSRT("BY"))-1)
SET X(1)="0,"_X(1)
End DoDot:1
+8 IF X(1)=-3
SET X=-1
QUIT
+9 SET @EN("NEXT")=X(1)
+10 QUIT
LSTC ; By EQUIPMENT CATEGORY
+1 SET X(2)=$PIECE($GET(^ENG(6914,DA,1)),U)
if X(2)=""
SET X(1)=0
+2 IF X(2)>0
SET X(1)=$PIECE($GET(^ENG(6911,X(2),0)),U)
if X(1)=""
SET X(1)=0
+3 if X(1)'?.N
SET X(1)=""""_X(1)_""""
+4 IF 'ENSRT("ALL")
IF X(2)'=ENSRT("FR")
SET X=-1
QUIT
+5 SET @EN("NEXT")=X(1)
SET EN("NEXT")=$CHAR($ASCII(EN("NEXT"))+1)
+6 IF ENSRT("LOC")
Begin DoDot:1
+7 SET X(1)=$$LOC^ENEQPMS8(DA)
IF X(1)=-1
SET X=-1
QUIT
+8 IF $PIECE(X(1),U)=-2
IF ENSRT("LOC","ALL")
Begin DoDot:2
+9 SET X(1)=""""_$PIECE(X(1),U,2)_""""
+10 FOR J=1:1:($LENGTH(ENSRT("BY"))-1)
SET X(1)="0,"_X(1)
End DoDot:2
+11 IF $PIECE(X(1),U)=-2
SET X=-1
QUIT
+12 IF X(1)=-3
IF ENSRT("LOC","ALL")
Begin DoDot:2
+13 SET X(1)=0
FOR J=1:1:($LENGTH(ENSRT("BY"))-1)
SET X(1)="0,"_X(1)
End DoDot:2
+14 IF X(1)=-3
SET X=-1
QUIT
+15 SET @EN("NEXT")=X(1)
End DoDot:1
+16 QUIT
LSTS ; By OWNING SERVICE
+1 SET X(2)=$PIECE($GET(^ENG(6914,DA,3)),U,2)
if X(2)=""
SET X(1)=0
+2 IF X(2)>0
SET X(1)=$PIECE($GET(^DIC(49,X(2),0)),U)
if X(1)=""
SET X(1)=0
+3 if X(1)'?.N
SET X(1)=""""_X(1)_""""
+4 IF 'ENSRT("ALL")
IF X(2)'=ENSRT("FR")
SET X=-1
QUIT
+5 SET @EN("NEXT")=X(1)
SET EN("NEXT")=$CHAR($ASCII(EN("NEXT"))+1)
+6 IF ENSRT("LOC")
Begin DoDot:1
+7 SET X(1)=$$LOC^ENEQPMS8(DA)
IF X(1)=-1
SET X=-1
QUIT
+8 IF $PIECE(X(1),U)=-2
IF ENSRT("LOC","ALL")
Begin DoDot:2
+9 SET X(1)=""""_$PIECE(X(1),U,2)_""""
+10 FOR J=1:1:($LENGTH(ENSRT("BY"))-1)
SET X(1)="0,"_X(1)
End DoDot:2
+11 IF $PIECE(X(1),U)=-2
SET X=-1
QUIT
+12 IF X(1)=-3
IF ENSRT("LOC","ALL")
Begin DoDot:2
+13 SET X(1)=0
FOR J=1:1:($LENGTH(ENSRT("BY"))-1)
SET X(1)="0,"_X(1)
End DoDot:2
+14 IF X(1)=-3
SET X=-1
QUIT
+15 SET @EN("NEXT")=X(1)
End DoDot:1
+16 QUIT
+17 ;
BLD ; build ^TMP global from which to print Y2K worklist
+1 SET NODE="^TMP($J,""ENY2"","_ENSHKEY_","_SUB_DA_")"
+2 SET @NODE=""
+3 QUIT
+4 ;
OUT KILL K,S,ENPM,ENPMDT,ENA,ENHZS,ENPMWK,ENSHOP,ENSHKEY,ENPMMN,ENSTMN,ENSTYR,ENCRIT,ENSRT,ENTECH,ENY,ENERR,ENMN,ENMNTH,ENI,ENLID
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
+3 ;ENY2K3
