- 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 Mar 13, 2025@20:57:12 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
