source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHEA1.m@ 1424

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1PRCHEA1 ;SF-ISC/TKW/DST/AS-MORE EDIT ROUTINES FOR SUPPLY SYSTEM ;3/8/05
2V ;;5.1;IFCAP;**81**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN0 ;REACTIVATE VENDOR
6 ;
7 S PRCHREAV="I $D(^(10)),$P(^(10),U,5)"
8 S DIC="^PRC(440,"
9 S DIE=DIC
10 S DIC(0)="AEMQZ"
11 D ^DIC
12 G Q:Y<0
13 S DA=+Y
14 L +^PRC(440,DA):0 E W !,$C(7),"ANOTHER USER IS EDITING THIS ENTRY!" K DA
15 G Q:'$D(DA)
16 ;
17 ;NOW THE RECORD IS LOCKED
18 ;
19 S PRCHY=$P(Y(0),U,1)
20 I $E(PRCHY,1,2)="**" S PRCHY=$E(PRCHY,3,99)
21 S IEN=" "_DA
22 S IEN=$E(IEN,$L(IEN)-5,99)
23 W !,"Sure you want to RE-activate Vendor "_PRCHY_", NO:"_IEN
24 S %B=""
25 S %=2
26 D ^PRCFYN
27 I %=1 D
28 . S DR=".01////^S X=PRCHY;15////@;31.5////@"
29 . D ^DIE
30 . ; SEND VENDOR UPDATE INFORMATION TO DYNAMED **81**
31 . D:$$GET^XPAR("SYS","PRCV COTS INVENTORY",1)=1 ONECHK^PRCVNDR(DA)
32 . Q
33 ;
34 ;UNLOCK THE RECORD
35 ;
36 L -^PRC(440,DA)
37 D Q
38 G EN0
39 ;
40EN1 ;INACTIVATE VENDOR
41 ;
42 K PRCHREAV
43 I '$D(DT) D
44 . D NOW^%DTC
45 . S DT=$P(%,".",1)
46 . Q
47 N DIC
48 S DIC="^PRC(440,"
49 S DIC(0)="AEMQZ"
50 D ^DIC
51 G Q:Y<0
52 I $D(^PRC(440,+Y,10)),$P(^(10),U,5)=1 W $C(7),!,"Please choose another vendor that is not inactivated." G EN1
53 S (PRCHOLD,DA)=+Y
54 S PRCHY=$P(Y(0),U,1)
55 L +^PRC(440,DA):0 E W !,$C(7),"ANOTHER USER IS EDITING THIS ENTRY!" K DA
56 G Q:'$D(DA)
57 ;
58 ;NOW THE RECORD IS LOCKED
59 ;
60 W !!,"Enter the Vendor you want to substitute for the inactivated vendor "
61 S DIC("S")="I $S(PRCHOLD=+Y:0,'$D(^(10)):1,+$P(^(10),U,5)=0:1,1:0)"
62 S DIC("A")="Select REPLACEMENT VENDOR: "
63 S PRCHX=""
64 S PRCHY="**"_$E($P(Y(0),U,1),1,34)
65 D ^DIC
66 S:Y>0 PRCHX=+Y
67 S IENS=" "_PRCHX
68 S IENS=$E(IENS,$L(IENS)-5,99)
69 S IENO=" "_PRCHOLD
70 S IENO=$E(IENO,$L(IENO)-5,99)
71 W !!,"Sure you want to inactivate Vendor "_$P(^PRC(440,PRCHOLD,0),U)_", NO:"_IENO
72 W:PRCHX !," and substitute vendor "_$P(^PRC(440,PRCHX,0),U)_", NO:"_IENS
73 S %B=""
74 S %=2
75 D ^PRCFYN
76 I %=1 D
77 . S DIE="^PRC(440,"
78 . S DA=PRCHOLD
79 . S DR=".01////^S X=PRCHY;15////^S X=PRCHX;31.5///^S X=1"
80 . D ^DIE
81 . ; SEND VENDOR UPDATE INFORMATION TO DYNAMED **81**
82 . D:$$GET^XPAR("SYS","PRCV COTS INVENTORY",1)=1 ONECHK^PRCVNDR(DA)
83 . Q
84 ;
85 ;UNLOCK THE RECORD
86 ;
87 L -^PRC(440,DA)
88 D Q
89 G EN1
90 ;
91EN2 ;INACTIVATE ITEM
92 ;
93 K PRCHREAV
94 I '$D(DT) D
95 . D NOW^%DTC
96 . S DT=$P(%,".",1)
97 . Q
98 K DIC
99 S DIC="^PRC(441,"
100 S DIC(0)="AEMQZ"
101 D ^DIC
102 G Q:Y<0
103 I $P(Y(0),"^",2)["*" W $C(7),!," ITEM ALREADY INACTIVE" G EN2
104 S DA=+Y
105 L +^PRC(441,DA):0 E W !,$C(7),"ANOTHER USER IS EDITING THIS ENTRY!" K DA
106 G Q:'$D(DA)
107 ;
108 ;NOW THE RECORD IS LOCKED
109 ;
110 S PRCHOLD=DA
111 W !!,"Enter the item you want to substitute for the inactivated item "
112 S DIC("A")="SELECT Substitute Item: "
113 S PRCHY="**"_$E($P(Y(0),U,2),1,58)
114 D ^DIC
115 S PRCHZ=$S(+Y>0:+Y,1:"")
116 W !!,"Sure you want to inactivate Item ",PRCHOLD
117 W:+Y>0 " and substitute Item ",+Y
118 S %B=""
119 S %=2
120 D ^PRCFYN
121 I %=1 D
122 . S DIE="^PRC(441,"
123 . S DA=PRCHOLD
124 . S DR=".05////^S X=PRCHY;16////^S X=1"
125 . S:PRCHZ DR=DR_";16.5////^S X=PRCHZ"
126 . D ^DIE
127 . ; Send ITEM Master File updated info to DYNAMED
128 . D:$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")=1 ONECHK^PRCVIT(DA)
129 . Q
130 ;
131 ;UNLOCK THE RECORD
132 ;
133 L -^PRC(441,DA)
134 D Q
135 G EN2
136 ;
137EN3 ;REACTIVATE ITEM
138 ;
139 S PRCHREAV="I $D(^(3)),+^(3)"
140 S DIC="^PRC(441,"
141 S DIE=DIC
142 S DIC(0)="AEMQZ"
143 D ^DIC
144 G Q:Y<0
145 S DA=+Y
146 L +^PRC(441,DA):0 E W !,$C(7),"ANOTHER USER IS EDITING THIS ENTRY!" K DA
147 G Q:'$D(DA)
148 ;
149 ;NOW THE RECORD IS LOCKED
150 ;
151 S PRCHY=$P(Y(0),U,2)
152 I $E(PRCHY,1,2)="**" S PRCHY=$E(PRCHY,3,99)
153 W !,"Sure you want to RE-activate Item number ",DA
154 S %B=""
155 S %=2
156 D ^PRCFYN
157 I %=1 D
158 . S DR=".05////^S X=PRCHY;16////@;16.5////@"
159 . D ^DIE
160 . ; Send ITEM Master File updated info to DYNAMED
161 . D:$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")=1 ONECHK^PRCVIT(DA)
162 . Q
163 ;
164 ;UNLOCK THE RECORD
165 ;
166 L -^PRC(441,DA)
167 D Q
168 G EN3
169 ;
170Q K DIC,DIE,DR,DA,PRCHOLD,PRCHREAV,PRCHX,PRCHY,PRCHZ
171 W !
172 Q
Note: See TracBrowser for help on using the repository browser.