source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOVL.m@ 691

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

initial load of WorldVistAEHR
File size: 6.3 KB
Line 
1PRCOVL ;WISC/DKM/BGJ-IFCAP AR VENDOR EDIT ROUTINE ;[10/19/98 2:36pm]
2V ;;5.1;IFCAP;**7**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for PRCO VENDOR EDIT FOR AR
6 ; FIRST LETS SEE IF THERE ARE ANY VENDOR RECORDS TO EDIT.
7 S COUNT=$O(^PRCF(422.2,"B","AR-EDIT-01",0)) G:COUNT'>0 NONE
8 S COUNT=$P($G(^PRCF(422.2,COUNT,0)),U,2) G:COUNT'>0 NONE
9 K COUNT
10 ;
11 ; GET TERMINAL ATTRIBUTES.
12 ;
13 I '$D(IOF)!('$G(IOST(0))) S IOP="HOME" D ^%ZIS K IOP
14 S X="IORVON;IORVOFF" D ENDR^%ZISS
15 S PRCO("RV1")=$G(IORVON),PRCO("RV0")=$G(IORVOFF)
16 S PRCO("XY")="N DX,DY S (DX,DY)=0 "_$G(^%ZOSF("XY"))
17 D EN^VALM("PRCO VENDOR EDIT FOR AR")
18 Q
19 ;
20HDR ; -- header code
21 S VALMHDR(1)="Edit vendor selected by AR user"
22 Q
23 ;
24INIT ; -- init variables and list array
25 K ^TMP("PRCOVL",$J)
26 S LOST=0
27 S NAME=""
28 I $O(^PRC(440.3,"AE",NAME))="" W !,"No Vendor records to edit." G NONE
29INITA D CLEAN^VALM10
30 S COUNT=0
31 S LINENO=0
32 S NAME=""
33 F S NAME=$O(^PRC(440.3,"AE",NAME)) Q:NAME="" D
34 . S LIST=0
35 . F S LIST=$O(^PRC(440.3,"AE",NAME,LIST)) Q:LIST="" D
36 . . S NAME=$S($G(NAME)]"":NAME,1:$P($G(^PRC(440,LIST,0)),U)) Q:NAME=""
37 . . I $G(^PRC(440.3,LIST,"AR"))']"" D Q
38 . . . K ^PRC(440.3,LIST)
39 . . . K ^PRC(440.3,"AD",NAME,LIST,LIST)
40 . . . K ^PRC(440.3,"AE",NAME,LIST,LIST)
41 . . . Q
42 . . S VDA=0
43 . . F S VDA=$O(^PRC(440.3,"AE",NAME,LIST,VDA)) Q:VDA="" D
44 . . . S COUNT=COUNT+1
45 . . . S SENT=$P($G(^PRC(440.3,VDA,"AR")),U,5)
46 . . . S OK=$P($G(^PRC(440.3,VDA,"AR")),U,4)
47 . . . S TAX=$P($G(^PRC(440,VDA,3)),U,8)
48 . . . S X=$$SETFLD^VALM1(COUNT,"","NUMBER")
49 . . . S X=$$SETFLD^VALM1(NAME,X,"VENDOR")
50 . . . S X=$$SETFLD^VALM1(TAX,X,"TAX ID/SSN")
51 . . . S X=$$SETFLD^VALM1(OK,X,"OK")
52 . . . S X=$$SETFLD^VALM1(SENT,X,"SENT")
53 . . . S LINENO=LINENO+1
54 . . . D SET^VALM10(COUNT,X,LINENO)
55 . . . S ^TMP("PRCOVL",$J,LINENO)=COUNT_"^"_LIST
56 . . . Q
57 . . Q
58 . Q
59 S VALMCNT=COUNT
60 S LN=$O(^PRCF(422.2,"B","AR-EDIT-01",0))
61 S $P(^PRCF(422.2,LN,0),U,2)=COUNT
62 Q
63 ;
64HELP ; -- help code
65 S X="?" D DISP^XQORM1 W !!
66 Q
67 ;
68EXIT ; -- exit code
69 Q
70 ;
71EXPND ; -- expand code
72 Q
73 ;
74NONE ; COME HERE IF THERE ARE NO VENDOR RECORDS TO EDIT.
75 W !!,"There are no vendor records to edit at this time."
76NONE1 S DIR(0)="E"
77 S DIR("A")="Enter RETURN to continue"
78 D ^DIR
79 K DIR
80 Q
81 ;
82REV ;COMPLETE REVIEW OF VENDOR ENTRY
83 N SPACE,VALMY,IEN,PRCOI,PRCOIN,DIC,DA,DR,DIQ,DIR,Y
84 D EN^VALM2(XQORNOD(0),"OS")
85 S PRCOI=0
86 S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
87 S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
88 S IEN=+$P(PRCOIN,U,2)
89 D FULL^VALM1
90REV1 W @IOF
91 K PRCORVP
92 S DIC="^PRC(440,",DA=IEN,DR=".01:46",DIQ="PRCORVP",DIQ(0)="E"
93 D EN^DIQ1
94 S $P(SPACE," ",24)=" "
95 W !!," Vendor Name: "_$$FIELD(IEN,.01)
96 W ?70,"PAGE: 1"
97 W !," Ordering Address: "_$$FIELD(IEN,1)
98 W:$$FIELD(IEN,2)]"" !,SPACE_$$FIELD(IEN,2)
99 S X=" City,State,ZIP: "
100 S:$$FIELD(IEN,4.2)]"" X=X_$$FIELD(IEN,4.2)_", "
101 S:$$FIELD(IEN,4.4)]"" X=X_$$FIELD(IEN,4.4)_" "
102 S X=X_$S($L($$FIELD(IEN,4.6))=9:$E($$FIELD(IEN,4.6),1,5)_"-"_$E($$FIELD(IEN,4.6),6,9),1:$$FIELD(IEN,4.6))
103 W !,X
104 W !!," FMS Name: "_$$FIELD(IEN,34.5)
105 W !!," * Payment ADDRESS: "_$$FIELD(IEN,17.3)
106 W !," "_$$FIELD(IEN,17.4)
107 W:$$FIELD(IEN,17.5)]"" !,SPACE_$$FIELD(IEN,17.5)
108 W:$$FIELD(IEN,17.6)]"" !,SPACE_$$FIELD(IEN,17.6)
109 S X=" * City,State,ZIP: "
110 S:$$FIELD(IEN,17.7)]"" X=X_$$FIELD(IEN,17.7)_", "
111 S:$$FIELD(IEN,17.8)]"" X=X_$$FIELD(IEN,17.8)_" "
112 S X=X_$S($L($$FIELD(IEN,17.9))=9:$E($$FIELD(IEN,17.9),1,5)_"-"_$E($$FIELD(IEN,17.9),6,9),1:$$FIELD(IEN,17.9))
113 W !,X
114 W !!,"PAYMENT CONTACT PERSON: "_$$FIELD(IEN,17)
115 W !," PAYMENT PHONE NUMBER: "_$$FIELD(IEN,7.2)
116 W !
117 W !," * = REQUIRED FIELD"
118 W !
119 S DIR(0)="E"
120 D ^DIR
121 K DIR
122 W !
123 G:Y'=1 REVEXIT
124 W @IOF
125 W !!," Vendor Name: "_$$FIELD(IEN,.01)
126 W ?70,"PAGE: 2"
127 W !!," FMS VENDOR CODE: "_$$FIELD(IEN,34)
128 W !," ALT-ADDR-IND: "_$$FIELD(IEN,35)
129 W !," * TAX ID/SSN: "_$$FIELD(IEN,38)
130 W !," * SSN/TAX ID IND: "_$$FIELD(IEN,39)
131 W !!," NON-RECURRING/"
132 W !," RECURRUNG VENDOR: "_$$FIELD(IEN,36)
133 W !!," 1099 VENDOR INDICATOR: "_$$FIELD(IEN,41)
134 W !," * VENDOR TYPE: "_$$FIELD(IEN,44)
135 W !," DUN & BRADSTREET: "_$$FIELD(IEN,18.3)
136 W !
137 W !," * = REQUIRED FIELD"
138 W !
139 S DIR(0)="E"
140 S DIR("A")="Enter RETURN to continue"
141 D ^DIR
142 K DIR
143REVEXIT I $G(RETURN)=961 G REVQ
144 S VALMBCK="R",VALMBG=1
145REVQ Q
146 ;
147FIELD(IEN,FIELD) ;FETCH EXTERNAL VALUE OF FIELD
148 ;FOR RECORD 'IEN' FROM FILE 440.3
149 S FIELD=$G(PRCORVP(440,IEN,FIELD,"E"))
150 Q FIELD
151 ;
152EDIT ;EDIT THIS VENDOR
153 N PRCOI,PRCOIN,IEN,RETURN
154 D EN^VALM2(XQORNOD(0),"OS")
155 S PRCOI=0
156 S PRCOI=$O(VALMY(PRCOI))
157 G:'PRCOI REVQ
158 S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
159 S IEN=+$P(PRCOIN,U,2)
160 S SENT=$P($G(^PRC(440.3,IEN,"AR")),U,5)
161 I SENT]"" W !!,"This record has already been sent to Austin or FISCAL." D NONE1 G EDITEX
162 D FULL^VALM1
163 W @IOF
164 S NAME=$P($G(^PRC(440,IEN,0)),U)
165 W:NAME]"" !!?11,"Vendor Name: "_NAME
166 D HILO^PRCFQ
167 S (DA,PRCFA("VEND"))=IEN
168 W !
169 S DIR(0)="Y"
170 S DIR("A")="Review the vendor selected"
171 S DIR("B")="YES"
172 D ^DIR
173 K DIR
174 W !
175 G:$D(DIRUT) EDITEX
176 I +Y=1 SET RETURN=961 D REV1 W @IOF
177 K PRCTMP,RETURN
178 D DOIT
179 G:$D(DIRUT)!(Y'=1) EDITEX
180 D SCREEN
181 L +^PRC(440,DA):5 E W !,$C(7),"Another user is editing this entry!" G EDITEX
182 S DIE="^PRC(440,"
183 S DR=$S(LOCAT="S":"[PRCHVENDOR]",1:"[PRCF FMS VENEDIT1B]")
184 D ^DIE
185 K DIE,DR,ORDER
186 S ARFLG=$G(^PRC(440.3,PRCFA("VEND"),"AR"))
187 S IEN=$P(ARFLG,U,2)
188 S PRC("SITE")=$P(ARFLG,U,3)
189 S FLAG=$P(ARFLG,U)
190 S SAVE=$$CHECK^PRCOVTST(IEN,PRC("SITE"),FLAG)
191 S SAVE1=$S(SAVE=0:"OK",SAVE=2:"GOOD",1:"")
192 S TAX=$P($G(^PRC(440,IEN,3)),U,8)
193 S DA=IEN
194 S DIE="^PRC(440.3,"
195 S DR=$S(SAVE=0:"53///^S X=SAVE1",SAVE=2:"53///^S X=SAVE1",1:"53///@")
196 D ^DIE
197 S X=@VALMAR@(PRCOI,0)
198 S OK=$S(SAVE=0:"OK",1:"")
199 S X=$$SETFLD^VALM1(OK,X,"OK")
200 S X=$$SETFLD^VALM1(TAX,X,"TAX ID/SSN")
201 S @VALMAR@(PRCOI,0)=X
202 L -^PRC(440,PRCFA("VEND"))
203EDITEX S VALMBCK="R",VALMBG=1
204 Q
205 ;
206DOIT ;FIND OUT IF USER WANTS TO EDIT VENDOR RECORD
207 W !
208 S DIR(0)="Y"
209 S DIR("A")="Edit the Vendor record"
210 S DIR("B")="YES"
211 S DIR("?")="Enter 'NO' or 'N' or '^' to exit this edit session."
212 S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue."
213 D ^DIR
214 K DIR
215 W !
216 Q
217 ;
218SCREEN ; Control screen display
219 I $D(IOF) W @IOF
220 ; Write Option Header
221 I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM,!
222 Q
Note: See TracBrowser for help on using the repository browser.