source: FOIAVistA/trunk/r/ENGINEERING-EN/ENEQ1.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 6.0 KB
Line 
1ENEQ1 ;WIRMFO/DH,SAB-Enter Equipment Records ;12.18.97
2 ;;7.0;ENGINEERING;**14,25,29,35,47**;Aug 17, 1993
3 ;
4EQAD ;New Inventory Entry Point
5 S END=0
6 N IOINLOW,IOINHI D ZIS^ENUTL
7 D ASKEDM G:END EQADX
8 ;
9 F D Q:END
10 . W @IOF,!!!
11 . S DIR(0)="Y",DIR("A")="Enter a new equipment inventory item"
12 . S DIR("B")="NO"
13 . S DIR("?")="Enter 'Y' to add a new Equipment Record."
14 . W @IOF,!!! D ^DIR K DIR I 'Y S END=1 Q
15 . D ASKSER Q:END Q:'$D(ENSERIAL)
16 . D ADDEQ
17EQADX ;
18 K DA,DIC,DIE,DIK,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
19 K END,ENDA,ENDR,ENNXL,ENSCRN
20 Q
21 ;
22EQMAD ;Multiple Inventory Entry Point
23 S END=0,ENMA=1
24 N IOINLOW,IOINHI D ZIS^ENUTL
25 W @IOF,!!!
26 S DIR(0)="Y",DIR("A")="Enter multiple equipment inventory items"
27 S DIR("B")="NO"
28 S DIR("?",1)="This option allows a rapid entry of multiple items which"
29 S DIR("?",2)="are alike; e.g. 25 new electric beds."
30 S DIR("?")="Enter YES or NO"
31 D ^DIR K DIR G:'Y EQMADX
32 ;
33 D ASKEDM G:END EQMADX
34 ;
35 W !!,"Proceed by entering the first item in full"
36 S DIR(0)="E" D ^DIR K DIR G:$D(DIRUT) EQMADX
37 ;
38 D ASKSER G:END EQMADX G:'$D(ENSERIAL) EQMAD
39 ;
40 D ADDEQ I 'ENNXL G EQMADX
41 ;
42 W @IOF,!!!,"For each additional equipment entry enter:"
43 W !," SERIAL #, LOCATION, VA PM NUMBER, and LOCAL IDENTIFIER (if any)."
44 F D Q:END
45 . W !!
46 . S DIR(0)="Y",DIR("A")="Enter another item",DIR("B")="YES"
47 . S DIR("?")="Enter YES to add another similar equipment item"
48 . D ^DIR K DIR I 'Y S END=1 Q
49 . S ENDAOLD=ENNXL
50 . D EQMAS^ENEQ3 I 'ENNXL S ENNXL=ENDAOLD
51 . K ENDAOLD
52 ;
53EQMADX ;
54 K DA,DIC,DIE,DIK,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,Y
55 K END,ENDA,ENDR,ENMA,ENNXL,ENSCRN
56 Q
57 ;
58ASKEDM ; ask edit method (screen or template)
59 ; out
60 ; ENSCRN - flag: true when screen entry
61 ; ENDR - input template when ENSCRN = 0
62 ; END - true when timeout or '^'
63 S DIR(0)="Y",DIR("A")="Screen entry",DIR("B")="YES"
64 S DIR("?")="Enter 'Y' for screen handler, 'N' for standard FileMan."
65 D ^DIR K DIR S:$D(DIRUT) END=1 S ENSCRN=Y
66 S:ENSCRN=0 ENDR=$S($D(^DIE("B","ENZEQENTER")):"[ENZ",1:"[EN")_"EQENTER]"
67 Q
68 ;
69ASKSER ; ask serial # and check file for duplicates
70 ; out
71 ; ENSERIAL - contains entered serial # or
72 ; undefined if user did not reconfirm after a match
73 ; END - true when timeout or '^'
74 N DA,ENI,ENMATCH,ENX
75 ; ask serial #
76 S ENSERIAL=""
77 W !!,"Please enter SERIAL # if available. Otherwise press <return>."
78 S DIR(0)="6914,5" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S END=1 Q
79 S ENSERIAL=Y
80 Q:ENSERIAL=""
81 ; look for matches
82 S ENX=$$UP^XLFSTR($TR(ENSERIAL," !""#$%&'()*+,-./:;<=>?@[\]^_`{|}~",""))
83 S ENX=$E(ENX_" ",1,30)
84 S ENI=0 F S ENI=$O(^ENG(6914,"FC",ENX,ENI)) Q:'ENI S ENMATCH(ENI)=""
85 ; if match show list, reconfirm
86 I $D(ENMATCH) D
87 . W !,"List of existing equipment with a similar Serial #"
88 . W !,?2,"Entry #",?14,"Manufacturer"
89 . S ENI=0 F S ENI=$O(ENMATCH(ENI)) Q:'ENI D
90 . . W !,?2,ENI,?14,$E($$GET1^DIQ(6914,ENI,1),1,60)
91 . . W !,?4,"Mod: ",$$GET1^DIQ(6914,ENI,4)
92 . . W ?40,"Ser #: ",$$GET1^DIQ(6914,ENI,5)
93 . S DIR(0)="Y",DIR("A")="Do you still want to add this new record"
94 . S DIR("B")="NO" D ^DIR K DIR S:$D(DIRUT) END=1 I 'Y K ENSERIAL
95 Q
96 ;
97ADDEQ ; add new equipment item
98 ; in
99 ; ENSERIAL (optional) contains serial #
100 ; ENMA (optional) flag, true if multiple equipment entry
101 ; out
102 ; ENNXL - ien of new equipment record, 0 if unsuccessful
103 ; also when $G(ENMA) true
104 ; ENMA("FAP") - flag, true if FA Document generated
105 ; ENMA("IIWO") - flag, true if Incom. Insp. W.O. generated
106 ; also when $G(ENMA("IIWO")) true
107 ; ENMA("IIWO","DA") - ien of created w.o.
108 ; ENMA("IIWO","ION") - ION where w.o. printed
109 ; ENMA("IIWO","QDT") - queued date/time if w.o. tasked
110 ; create new record
111 D ENR I 'ENNXL W $C(7),!,ENERR S DIR(0)="E" D ^DIR K DIR,ENERR Q
112 ; lock new record
113 L +^ENG(6914,ENNXL):1 I '$T D Q
114 . W !!,$C(7),"Another user is editing Entry # ",ENNXL,". Can't proceed."
115 ; populate serial #
116 I $G(ENSERIAL)]"" S DIE="^ENG(6914,",DR="5////"_ENSERIAL,DA=ENNXL D ^DIE
117 ; user edit new record
118 I ENSCRN D
119 . S DJSC="ENEQ1",(DJDN,ENDA,DA)=ENNXL
120 . D EN^ENJ W IOINLOW
121 . K DJD0,DJDIS,DJDN,DJLG,DJSC,DJSW2
122 I 'ENSCRN S DIE="^ENG(6914,",DR=ENDR,DA=ENNXL D ^DIE
123 ; enter PM schedule
124 I $D(^XUSEC("ENEDPM",DUZ)) D
125 . S DIR(0)="Y",DIR("B")="YES"
126 . S DIR("A")="Would you like to include this item in the PM program"
127 . D ^DIR K DIR Q:'Y
128 . N ENXP
129 . S DIE="^ENG(6914,",(DA,ENDA)=ENNXL,ENXP=1
130 . I $D(^ENG(6914,DA,4)) D DINV^ENEQPMP3 Q:X="^"
131 . D XNPMSE^ENEQPMP
132 ; generate incoming inspection W.O.?
133 S ENI=$O(^ENG(6910.2,"B","ASK INCOMING INSPECTION W.O.",0))
134 I ENI,$P(^ENG(6910.2,ENI,0),U,2) D
135 . S DIR(0)="Y",DIR("A")="Create an Incoming Inspection Work Order"
136 . S DIR("B")=$S($P(^ENG(6910.2,ENI,0),U,2)=2:"YES",1:"NO")
137 . D ^DIR K DIR S:$G(ENMA) ENMA("IIWO")=$S(Y>0:1,1:0)
138 . I Y D IIWO^ENWONEW3(ENNXL) I $G(ENMA) D
139 . . S ENMA("IIWO","DA")=ENDA
140 . . S ENMA("IIWO","ION")=$G(ENION)
141 . . S ENMA("IIWO","QDT")=$G(ENQDT)
142 . . K ENDA,ENION,ENQDT
143 ; generate FA Document?
144 I $D(^XUSEC("ENFACS",DUZ)),$P(^ENG(6914,ENNXL,0),U,4)="NX",$P($G(^(8)),U,2) D
145 . W !!,"This Equipment Record is both NONEXPENDABLE and CAPITALIZED."
146 . W:$G(ENMA) !,"The same will be true of other records created using this option."
147 . S DIR(0)="Y",DIR("A")="Do you wish to send an FA document to Austin"
148 . S DIR("B")="YES"
149 . D ^DIR K DIR S:$G(ENMA) ENMA("FAP")=$S(Y>0:1,1:0)
150 . I Y S ENEQ("DA")=ENNXL D ^ENFAACQ K ENEQ("DA")
151 ; generate new equipment bulletin
152 S DA=ENNXL D BULL^ENEQ3
153 ; unlock entry
154 L -^ENG(6914,ENNXL)
155 Q
156 ;
157ENR ; create entry with next available ien
158 ; out
159 ; DA,ENNXL - ien of new entry, 0 when unsuccessful
160 ; ENERR - error message if unsuccessful
161 S (DA,ENNXL)=0 K ENERR
162 I '$D(ZTQUEUED) W !,"...Setting up new equipment record"
163 N DD,DIC,DINUM,DO,X,Y
164 L +^ENG(6914,0):10
165 I '$T S ENERR="SORRY, CAN'T LOCK ^ENG(6914,0) GLOBAL, TRY LATER" Q
166 ;
167 S ENNXL=$P(^ENG(6914,0),"^",3)
168 F S ENNXL=ENNXL+1 Q:'$D(^ENG(6914,ENNXL,0))
169 ;
170 S DIC="^ENG(6914,",DIC(0)="LX",(DA,X,DINUM)=ENNXL
171 K DD,DO D FILE^DICN
172 S:Y'>0 (DA,ENNXL)=0,ENERR="Unable to add new record at this time..."
173 L -^ENG(6914,0)
174 Q
175 ;
176 ;ENEQ1
Note: See TracBrowser for help on using the repository browser.