source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENEQMED1.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.0 KB
RevLine 
[613]1ENEQMED1 ;WISC/SAB-Multiple Equipment Edit, Continued ;5/19/1998
2 ;;7.0;ENGINEERING;**35,39,51**;Aug 17, 1993
3FLD ; get fields and values
4 ; dic("s") contains national fields that can be edited and also
5 ; allows any local fields (Y>1000) to be selected
6 W !
7 S DIC="^DD(6914,",DIC(0)="AQE"
8 I ENFA D
9 . W !,"Note: Some fields can not be modified because one or more of the"
10 . W !,"selected equipment items are reported to Fixed Assets (FMS)."
11 . 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))"
12 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))"
13 D ^DIC K DIC G:$D(DTOUT)!$D(DUOUT) EXIT G:Y'>0 FLDEND
14 S ENFLD=+Y,ENFLDN=$P(Y,U,2)
15 K ^TMP($J,"ENFLD",ENFLD)
16 ; special handling for serial #, nxrn #, va pm number, replacing
17 I "^5^17^25^51^"[(U_ENFLD_U) D G:$D(DIRUT) EXIT G FLD
18 . W !,"This option requires that the ",ENFLDN," be individually entered"
19 . W !,"for each equipment item."
20 . S DIR(0)="Y",DIR("B")="NO"
21 . S DIR("A")="Should "_ENFLDN_" be asked for each of the "_ENC("SEL")_" items"
22 . D ^DIR K DIR I 'Y W !,ENFLDN," will not be changed." Q
23 . S ^TMP($J,"ENFLD",ENFLD)=""
24 ; special handling for parent system, location, local identifier
25 I "^2^24^26^"[(U_ENFLD_U) D G:$D(DIRUT) EXIT G:Y FLD
26 . W !,ENFLDN," can be individually entered for each equipment item."
27 . S DIR(0)="Y",DIR("B")="NO"
28 . S DIR("A")="Should "_ENFLDN_" be asked for each of the "_ENC("SEL")_" items"
29 . D ^DIR K DIR Q:$D(DIRUT) I Y S ^TMP($J,"ENFLD",ENFLD)=""
30 ; special handling for comments wp
31 I "^40^"[(U_ENFLD_U) D G FLD
32 . K ^TMP($J,"ENCOM")
33 . S DIC="^TMP($J,""ENCOM"",",DIWESUB="COMMENTS" D EN^DIWE K DIWESUB
34 . I $D(^TMP($J,"ENCOM")) S ^TMP($J,"ENFLD",ENFLD)="^TMP($J,""ENCOM"","
35 ; special handling for spex wp
36 I "^70^"[(U_ENFLD_U) D G FLD
37 . I '$D(^XUSEC("ENEDSPEX",DUZ)) D Q
38 . . W $C(7),!,"Can't edit SPEX. Security key ENEDSPEX is required."
39 . K ^TMP($J,"ENSPEX")
40 . S DIC="^TMP($J,""ENSPEX"",",DIWESUB="SPEX" D EN^DIWE K DIWESUB
41 . I $D(^TMP($J,"ENSPEX")) S ^TMP($J,"ENFLD",ENFLD)="^TMP($J,""ENSPEX"","
42 ; special handling fields requiring ENEDNX key
43 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
44 . W $C(7),!,ENFLDN," can not be modified because some of the selected"
45 . W !,"equipment items are NX and you do not hold security key ENEDNX."
46VAL ;
47 K DA S DA=ENDAT,DIR(0)="6914,"_ENFLD
48 D ^DIR K DIR G:$D(DTOUT) EXIT I $D(DUOUT) W !,ENFLDN," will not be changed." G FLD
49 S ENVALI=$P(Y,U)
50 S ENVALE=$P($G(Y(0)),U) S:ENVALE']"" ENVALE=$P(Y,U)
51 I X="@" D
52 . S DIR(0)="Y",DIR("A")="Do you want to delete "_ENFLDN
53 . D ^DIR K DIR Q:$D(DIRUT) I Y S ENVALI="@",ENVALE="(deleted)"
54 I ENVALI']"" W !,"You must enter a value (or '^' to skip field)" G VAL
55 S ^TMP($J,"ENFLD",ENFLD)=ENVALI_U_ENVALE
56 G FLD
57FLDEND ;
58 ; special handling for PM data
59 I $D(^XUSEC("ENEDPM",DUZ)) D G:$D(DIRUT) EXIT
60 . S DIR(0)="Y",DIR("B")="NO"
61 . S DIR("A")="Do you want to replace any existing PM data"
62 . D ^DIR K DIR Q:$D(DIRUT)!'Y
63 . S ENCATI=$P($G(^TMP($J,"ENFLD",6)),U)
64 . I ENCATI="" D
65 . . S ENC("CAT")=0
66 . . F ENI=1:1 S ENL=$P(ENL("SEL"),",",ENI) Q:'ENL D Q:ENC("CAT")>1
67 . . . I $P(ENL(ENL),U),ENCATI'=$P(ENL(ENL),U) S ENCATI=$P(ENL(ENL),U),ENC("CAT")=ENC("CAT")+1
68 . . I ENC("CAT")'=1 S ENCATI=""
69 . S ^ENG(6914,ENDAT,1)=ENCATI
70 . S DIE=6914,DA=ENDAT,ENXP=2 D XNPMSE^ENEQPMP
71 . K ENA,ENB,ENDA,ENDTYP,ENDVTYP,ENSH,ENSHOP
72 . S ^TMP($J,"ENFLD",30)=ENDAT
73 I '$D(^TMP($J,"ENFLD")) D G:Y FLD G EXIT
74 . W !,"No fields were specified!"
75 . S DIR(0)="Y",DIR("A")="Do you want to modify some fields"
76 . S DIR("B")="YES" D ^DIR K DIR
77 ; get values for individually asked fields (if any)
78 S ENASK=0
79 S ENFLD=0 F S ENFLD=$O(^TMP($J,"ENFLD",ENFLD)) Q:'ENFLD!ENASK I ^(ENFLD)="" S ENASK="1"
80 I ENASK W !,"Now enter data for fields which are asked for each item."
81 I ENASK S ENDA=0 F S ENDA=$O(^TMP($J,"ENSEL",ENDA)) Q:'ENDA D G:$D(DIRUT) EXIT
82 . W !!,"CONTROL #: ",ENDA
83 . S ENFLD=0
84 . F S ENFLD=$O(^TMP($J,"ENFLD",ENFLD)) Q:'ENFLD I ^(ENFLD)="" D Q:$D(DIRUT)
85 . . S ENFLDN=$$GET1^DID(6914,ENFLD,"","LABEL")
86 . . S ENGOT=0 F D Q:ENGOT!$D(DTOUT)!$D(DUOUT)
87 . . . K DA S DA=ENDA S DIR(0)="6914,"_ENFLD
88 . . . D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT)
89 . . . S ENVALI=$P(Y,U)
90 . . . S ENVALE=$P($G(Y(0)),U) S:ENVALE']"" ENVALE=$P(Y,U)
91 . . . I X="@" D
92 . . . . S DIR(0)="Y",DIR("A")="Do you want to delete "_ENFLDN
93 . . . . D ^DIR K DIR Q:$D(DIRUT) I Y S ENVALI="@",ENVALE="(deleted)"
94 . . . I ENVALI']"" D I Y!$D(DIRUT) Q
95 . . . . S DIR(0)="Y",DIR("B")="YES"
96 . . . . S DIR("A")="Do you want to enter a "_ENFLDN_" for this item"
97 . . . . D ^DIR K DIR
98 . . . I ENFLD=25,ENVALI]"",ENVALI'="@" D Q:ENI ; unique VA PM NUMBER
99 . . . . S ENI=0
100 . . . . F S ENI=$O(^TMP($J,"ENFLD",25,ENI)) Q:'ENI Q:$P($G(^(ENI)),U)=ENVALI
101 . . . . I ENI W $C(7),!,"IN USE (Entry Number: ",ENI,")"
102 . . . S ^TMP($J,"ENFLD",ENFLD,ENDA)=ENVALI_U_ENVALE
103 . . . S ENGOT=1
104 G UPD^ENEQMED2
105EXIT ;
106 G EXIT^ENEQMED2
107 ;ENEQMED1
Note: See TracBrowser for help on using the repository browser.