ENEQMED1 ;WISC/SAB-Multiple Equipment Edit, Continued ;5/19/1998
;;7.0;ENGINEERING;**35,39,51**;Aug 17, 1993
FLD ; get fields and values
; dic("s") contains national fields that can be edited and also
; allows any local fields (Y>1000) to be selected
W !
S DIC="^DD(6914,",DIC(0)="AQE"
I ENFA D
. W !,"Note: Some fields can not be modified because one or more of the"
. W !,"selected equipment items are reported to Fixed Assets (FMS)."
. S DIC("S")="I Y>1000!(""^1^2^3^4^5^6^10^11^12.5^13.5^14^17^19.5^19.6^20^21^24^25^26^27^33^40^51^52^53^70^""[(U_Y_U))"
I 'ENFA S DIC("S")="I Y>1000!(""^1^2^3^4^5^6^7^10^11^12^12.5^13^13.5^14^^15^16^17^18^19^19.5^19.6^20^20.1^20.5^21^22^24^25^26^27^31^32^33^34^35^38^40^51^52^53^60^61^62^63^64^70^""[(U_Y_U))"
D ^DIC K DIC G:$D(DTOUT)!$D(DUOUT) EXIT G:Y'>0 FLDEND
S ENFLD=+Y,ENFLDN=$P(Y,U,2)
K ^TMP($J,"ENFLD",ENFLD)
; special handling for serial #, nxrn #, va pm number, replacing
I "^5^17^25^51^"[(U_ENFLD_U) D G:$D(DIRUT) EXIT G FLD
. W !,"This option requires that the ",ENFLDN," be individually entered"
. W !,"for each equipment item."
. S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Should "_ENFLDN_" be asked for each of the "_ENC("SEL")_" items"
. D ^DIR K DIR I 'Y W !,ENFLDN," will not be changed." Q
. S ^TMP($J,"ENFLD",ENFLD)=""
; special handling for parent system, location, local identifier
I "^2^24^26^"[(U_ENFLD_U) D G:$D(DIRUT) EXIT G:Y FLD
. W !,ENFLDN," can be individually entered for each equipment item."
. S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Should "_ENFLDN_" be asked for each of the "_ENC("SEL")_" items"
. D ^DIR K DIR Q:$D(DIRUT) I Y S ^TMP($J,"ENFLD",ENFLD)=""
; special handling for comments wp
I "^40^"[(U_ENFLD_U) D G FLD
. K ^TMP($J,"ENCOM")
. S DIC="^TMP($J,""ENCOM"",",DIWESUB="COMMENTS" D EN^DIWE K DIWESUB
. I $D(^TMP($J,"ENCOM")) S ^TMP($J,"ENFLD",ENFLD)="^TMP($J,""ENCOM"","
; special handling for spex wp
I "^70^"[(U_ENFLD_U) D G FLD
. I '$D(^XUSEC("ENEDSPEX",DUZ)) D Q
. . W $C(7),!,"Can't edit SPEX. Security key ENEDSPEX is required."
. K ^TMP($J,"ENSPEX")
. S DIC="^TMP($J,""ENSPEX"",",DIWESUB="SPEX" D EN^DIWE K DIWESUB
. I $D(^TMP($J,"ENSPEX")) S ^TMP($J,"ENFLD",ENFLD)="^TMP($J,""ENSPEX"","
; special handling fields requiring ENEDNX key
I 'ENEDNX,ENNX,"^7^12^12.5^18^19^20.1^33^34^35^36^38^52^60^61^62^63^64^"[(U_ENFLD_U) D G FLD
. W $C(7),!,ENFLDN," can not be modified because some of the selected"
. W !,"equipment items are NX and you do not hold security key ENEDNX."
VAL ;
K DA S DA=ENDAT,DIR(0)="6914,"_ENFLD
D ^DIR K DIR G:$D(DTOUT) EXIT I $D(DUOUT) W !,ENFLDN," will not be changed." G FLD
S ENVALI=$P(Y,U)
S ENVALE=$P($G(Y(0)),U) S:ENVALE']"" ENVALE=$P(Y,U)
I X="@" D
. S DIR(0)="Y",DIR("A")="Do you want to delete "_ENFLDN
. D ^DIR K DIR Q:$D(DIRUT) I Y S ENVALI="@",ENVALE="(deleted)"
I ENVALI']"" W !,"You must enter a value (or '^' to skip field)" G VAL
S ^TMP($J,"ENFLD",ENFLD)=ENVALI_U_ENVALE
G FLD
FLDEND ;
; special handling for PM data
I $D(^XUSEC("ENEDPM",DUZ)) D G:$D(DIRUT) EXIT
. S DIR(0)="Y",DIR("B")="NO"
. S DIR("A")="Do you want to replace any existing PM data"
. D ^DIR K DIR Q:$D(DIRUT)!'Y
. S ENCATI=$P($G(^TMP($J,"ENFLD",6)),U)
. I ENCATI="" D
. . S ENC("CAT")=0
. . F ENI=1:1 S ENL=$P(ENL("SEL"),",",ENI) Q:'ENL D Q:ENC("CAT")>1
. . . I $P(ENL(ENL),U),ENCATI'=$P(ENL(ENL),U) S ENCATI=$P(ENL(ENL),U),ENC("CAT")=ENC("CAT")+1
. . I ENC("CAT")'=1 S ENCATI=""
. S ^ENG(6914,ENDAT,1)=ENCATI
. S DIE=6914,DA=ENDAT,ENXP=2 D XNPMSE^ENEQPMP
. K ENA,ENB,ENDA,ENDTYP,ENDVTYP,ENSH,ENSHOP
. S ^TMP($J,"ENFLD",30)=ENDAT
I '$D(^TMP($J,"ENFLD")) D G:Y FLD G EXIT
. W !,"No fields were specified!"
. S DIR(0)="Y",DIR("A")="Do you want to modify some fields"
. S DIR("B")="YES" D ^DIR K DIR
; get values for individually asked fields (if any)
S ENASK=0
S ENFLD=0 F S ENFLD=$O(^TMP($J,"ENFLD",ENFLD)) Q:'ENFLD!ENASK I ^(ENFLD)="" S ENASK="1"
I ENASK W !,"Now enter data for fields which are asked for each item."
I ENASK S ENDA=0 F S ENDA=$O(^TMP($J,"ENSEL",ENDA)) Q:'ENDA D G:$D(DIRUT) EXIT
. W !!,"CONTROL #: ",ENDA
. S ENFLD=0
. F S ENFLD=$O(^TMP($J,"ENFLD",ENFLD)) Q:'ENFLD I ^(ENFLD)="" D Q:$D(DIRUT)
. . S ENFLDN=$$GET1^DID(6914,ENFLD,"","LABEL")
. . S ENGOT=0 F D Q:ENGOT!$D(DTOUT)!$D(DUOUT)
. . . K DA S DA=ENDA S DIR(0)="6914,"_ENFLD
. . . D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT)
. . . S ENVALI=$P(Y,U)
. . . S ENVALE=$P($G(Y(0)),U) S:ENVALE']"" ENVALE=$P(Y,U)
. . . I X="@" D
. . . . S DIR(0)="Y",DIR("A")="Do you want to delete "_ENFLDN
. . . . D ^DIR K DIR Q:$D(DIRUT) I Y S ENVALI="@",ENVALE="(deleted)"
. . . I ENVALI']"" D I Y!$D(DIRUT) Q
. . . . S DIR(0)="Y",DIR("B")="YES"
. . . . S DIR("A")="Do you want to enter a "_ENFLDN_" for this item"
. . . . D ^DIR K DIR
. . . I ENFLD=25,ENVALI]"",ENVALI'="@" D Q:ENI ; unique VA PM NUMBER
. . . . S ENI=0
. . . . F S ENI=$O(^TMP($J,"ENFLD",25,ENI)) Q:'ENI Q:$P($G(^(ENI)),U)=ENVALI
. . . . I ENI W $C(7),!,"IN USE (Entry Number: ",ENI,")"
. . . S ^TMP($J,"ENFLD",ENFLD,ENDA)=ENVALI_U_ENVALE
. . . S ENGOT=1
G UPD^ENEQMED2
EXIT ;
G EXIT^ENEQMED2
;ENEQMED1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQMED1 5255 printed Dec 13, 2024@01:52:31 Page 2
ENEQMED1 ;WISC/SAB-Multiple Equipment Edit, Continued ;5/19/1998
+1 ;;7.0;ENGINEERING;**35,39,51**;Aug 17, 1993
FLD ; get fields and values
+1 ; dic("s") contains national fields that can be edited and also
+2 ; allows any local fields (Y>1000) to be selected
+3 WRITE !
+4 SET DIC="^DD(6914,"
SET DIC(0)="AQE"
+5 IF ENFA
Begin DoDot:1
+6 WRITE !,"Note: Some fields can not be modified because one or more of the"
+7 WRITE !,"selected equipment items are reported to Fixed Assets (FMS)."
+8 SET DIC("S")="I Y>1000!(""^1^2^3^4^5^6^10^11^12.5^13.5^14^17^19.5^19.6^20^21^24^25^26^27^33^40^51^52^53^70^""[(U_Y_U))"
End DoDot:1
+9 IF 'ENFA
SET DIC("S")="I Y>1000!(""^1^2^3^4^5^6^7^10^11^12^12.5^13^13.5^14^^15^16^17^18^19^19.5^19.6^20^20.1^20.5^21^22^24^25^26^27^31^32^33^34^35^38^40^51^52^53^60^61^62^63^64^70^""[(U_Y_U))"
+10 DO ^DIC
KILL DIC
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
if Y'>0
GOTO FLDEND
+11 SET ENFLD=+Y
SET ENFLDN=$PIECE(Y,U,2)
+12 KILL ^TMP($JOB,"ENFLD",ENFLD)
+13 ; special handling for serial #, nxrn #, va pm number, replacing
+14 IF "^5^17^25^51^"[(U_ENFLD_U)
Begin DoDot:1
+15 WRITE !,"This option requires that the ",ENFLDN," be individually entered"
+16 WRITE !,"for each equipment item."
+17 SET DIR(0)="Y"
SET DIR("B")="NO"
+18 SET DIR("A")="Should "_ENFLDN_" be asked for each of the "_ENC("SEL")_" items"
+19 DO ^DIR
KILL DIR
IF 'Y
WRITE !,ENFLDN," will not be changed."
QUIT
+20 SET ^TMP($JOB,"ENFLD",ENFLD)=""
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
GOTO FLD
+21 ; special handling for parent system, location, local identifier
+22 IF "^2^24^26^"[(U_ENFLD_U)
Begin DoDot:1
+23 WRITE !,ENFLDN," can be individually entered for each equipment item."
+24 SET DIR(0)="Y"
SET DIR("B")="NO"
+25 SET DIR("A")="Should "_ENFLDN_" be asked for each of the "_ENC("SEL")_" items"
+26 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
IF Y
SET ^TMP($JOB,"ENFLD",ENFLD)=""
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
if Y
GOTO FLD
+27 ; special handling for comments wp
+28 IF "^40^"[(U_ENFLD_U)
Begin DoDot:1
+29 KILL ^TMP($JOB,"ENCOM")
+30 SET DIC="^TMP($J,""ENCOM"","
SET DIWESUB="COMMENTS"
DO EN^DIWE
KILL DIWESUB
+31 IF $DATA(^TMP($JOB,"ENCOM"))
SET ^TMP($JOB,"ENFLD",ENFLD)="^TMP($J,""ENCOM"","
End DoDot:1
GOTO FLD
+32 ; special handling for spex wp
+33 IF "^70^"[(U_ENFLD_U)
Begin DoDot:1
+34 IF '$DATA(^XUSEC("ENEDSPEX",DUZ))
Begin DoDot:2
+35 WRITE $CHAR(7),!,"Can't edit SPEX. Security key ENEDSPEX is required."
End DoDot:2
QUIT
+36 KILL ^TMP($JOB,"ENSPEX")
+37 SET DIC="^TMP($J,""ENSPEX"","
SET DIWESUB="SPEX"
DO EN^DIWE
KILL DIWESUB
+38 IF $DATA(^TMP($JOB,"ENSPEX"))
SET ^TMP($JOB,"ENFLD",ENFLD)="^TMP($J,""ENSPEX"","
End DoDot:1
GOTO FLD
+39 ; special handling fields requiring ENEDNX key
+40 IF 'ENEDNX
IF ENNX
IF "^7^12^12.5^18^19^20.1^33^34^35^36^38^52^60^61^62^63^64^"[(U_ENFLD_U)
Begin DoDot:1
+41 WRITE $CHAR(7),!,ENFLDN," can not be modified because some of the selected"
+42 WRITE !,"equipment items are NX and you do not hold security key ENEDNX."
End DoDot:1
GOTO FLD
VAL ;
+1 KILL DA
SET DA=ENDAT
SET DIR(0)="6914,"_ENFLD
+2 DO ^DIR
KILL DIR
if $DATA(DTOUT)
GOTO EXIT
IF $DATA(DUOUT)
WRITE !,ENFLDN," will not be changed."
GOTO FLD
+3 SET ENVALI=$PIECE(Y,U)
+4 SET ENVALE=$PIECE($GET(Y(0)),U)
if ENVALE']""
SET ENVALE=$PIECE(Y,U)
+5 IF X="@"
Begin DoDot:1
+6 SET DIR(0)="Y"
SET DIR("A")="Do you want to delete "_ENFLDN
+7 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
IF Y
SET ENVALI="@"
SET ENVALE="(deleted)"
End DoDot:1
+8 IF ENVALI']""
WRITE !,"You must enter a value (or '^' to skip field)"
GOTO VAL
+9 SET ^TMP($JOB,"ENFLD",ENFLD)=ENVALI_U_ENVALE
+10 GOTO FLD
FLDEND ;
+1 ; special handling for PM data
+2 IF $DATA(^XUSEC("ENEDPM",DUZ))
Begin DoDot:1
+3 SET DIR(0)="Y"
SET DIR("B")="NO"
+4 SET DIR("A")="Do you want to replace any existing PM data"
+5 DO ^DIR
KILL DIR
if $DATA(DIRUT)!'Y
QUIT
+6 SET ENCATI=$PIECE($GET(^TMP($JOB,"ENFLD",6)),U)
+7 IF ENCATI=""
Begin DoDot:2
+8 SET ENC("CAT")=0
+9 FOR ENI=1:1
SET ENL=$PIECE(ENL("SEL"),",",ENI)
if 'ENL
QUIT
Begin DoDot:3
+10 IF $PIECE(ENL(ENL),U)
IF ENCATI'=$PIECE(ENL(ENL),U)
SET ENCATI=$PIECE(ENL(ENL),U)
SET ENC("CAT")=ENC("CAT")+1
End DoDot:3
if ENC("CAT")>1
QUIT
+11 IF ENC("CAT")'=1
SET ENCATI=""
End DoDot:2
+12 SET ^ENG(6914,ENDAT,1)=ENCATI
+13 SET DIE=6914
SET DA=ENDAT
SET ENXP=2
DO XNPMSE^ENEQPMP
+14 KILL ENA,ENB,ENDA,ENDTYP,ENDVTYP,ENSH,ENSHOP
+15 SET ^TMP($JOB,"ENFLD",30)=ENDAT
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+16 IF '$DATA(^TMP($JOB,"ENFLD"))
Begin DoDot:1
+17 WRITE !,"No fields were specified!"
+18 SET DIR(0)="Y"
SET DIR("A")="Do you want to modify some fields"
+19 SET DIR("B")="YES"
DO ^DIR
KILL DIR
End DoDot:1
if Y
GOTO FLD
GOTO EXIT
+20 ; get values for individually asked fields (if any)
+21 SET ENASK=0
+22 SET ENFLD=0
FOR
SET ENFLD=$ORDER(^TMP($JOB,"ENFLD",ENFLD))
if 'ENFLD!ENASK
QUIT
IF ^(ENFLD)=""
SET ENASK="1"
+23 IF ENASK
WRITE !,"Now enter data for fields which are asked for each item."
+24 IF ENASK
SET ENDA=0
FOR
SET ENDA=$ORDER(^TMP($JOB,"ENSEL",ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+25 WRITE !!,"CONTROL #: ",ENDA
+26 SET ENFLD=0
+27 FOR
SET ENFLD=$ORDER(^TMP($JOB,"ENFLD",ENFLD))
if 'ENFLD
QUIT
IF ^(ENFLD)=""
Begin DoDot:2
+28 SET ENFLDN=$$GET1^DID(6914,ENFLD,"","LABEL")
+29 SET ENGOT=0
FOR
Begin DoDot:3
+30 KILL DA
SET DA=ENDA
SET DIR(0)="6914,"_ENFLD
+31 DO ^DIR
KILL DIR
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+32 SET ENVALI=$PIECE(Y,U)
+33 SET ENVALE=$PIECE($GET(Y(0)),U)
if ENVALE']""
SET ENVALE=$PIECE(Y,U)
+34 IF X="@"
Begin DoDot:4
+35 SET DIR(0)="Y"
SET DIR("A")="Do you want to delete "_ENFLDN
+36 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
IF Y
SET ENVALI="@"
SET ENVALE="(deleted)"
End DoDot:4
+37 IF ENVALI']""
Begin DoDot:4
+38 SET DIR(0)="Y"
SET DIR("B")="YES"
+39 SET DIR("A")="Do you want to enter a "_ENFLDN_" for this item"
+40 DO ^DIR
KILL DIR
End DoDot:4
IF Y!$DATA(DIRUT)
QUIT
+41 ; unique VA PM NUMBER
IF ENFLD=25
IF ENVALI]""
IF ENVALI'="@"
Begin DoDot:4
+42 SET ENI=0
+43 FOR
SET ENI=$ORDER(^TMP($JOB,"ENFLD",25,ENI))
if 'ENI
QUIT
if $PIECE($GET(^(ENI)),U)=ENVALI
QUIT
+44 IF ENI
WRITE $CHAR(7),!,"IN USE (Entry Number: ",ENI,")"
End DoDot:4
if ENI
QUIT
+45 SET ^TMP($JOB,"ENFLD",ENFLD,ENDA)=ENVALI_U_ENVALE
+46 SET ENGOT=1
End DoDot:3
if ENGOT!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+47 GOTO UPD^ENEQMED2
EXIT ;
+1 GOTO EXIT^ENEQMED2
+2 ;ENEQMED1
