1 | PRCORV1 ;WISC/DJM/BGJ/AS-IFCAP VRQ REVIEW ROUTINE, CONTINUED ;3/8/05
|
---|
2 | V ;;5.1;IFCAP;**7,81**;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | REV ;COMPLETE REVIEW OF VENDOR ENTRY
|
---|
5 | N SPACE,VALMY,IEN,PRCOI,PRCOIN,DIC,DA,DR,DIQ,DIR,Y
|
---|
6 | D EN^VALM2(XQORNOD(0),"OS")
|
---|
7 | S PRCOI=0
|
---|
8 | S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
|
---|
9 | S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI))
|
---|
10 | S IEN=+$P(PRCOIN,U,2)
|
---|
11 | D FULL^VALM1
|
---|
12 | W @IOF
|
---|
13 | K PRCORVP
|
---|
14 | S DIC="^PRC(440,",DA=IEN,DR=".01:46",DIQ="PRCORVP",DIQ(0)="E"
|
---|
15 | D EN^DIQ1
|
---|
16 | S $P(SPACE," ",24)=" "
|
---|
17 | W !!," Vendor Name: "_$$FIELD(IEN,.01)
|
---|
18 | W ?70,"PAGE: 1"
|
---|
19 | W !," Ordering Address: "_$$FIELD(IEN,1)
|
---|
20 | W:$$FIELD(IEN,2)]"" !,SPACE_$$FIELD(IEN,2)
|
---|
21 | S X=SPACE
|
---|
22 | S:$$FIELD(IEN,4.2)]"" X=X_$$FIELD(IEN,4.2)_", "
|
---|
23 | S:$$FIELD(IEN,4.4)]"" X=X_$$FIELD(IEN,4.4)_" "
|
---|
24 | 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))
|
---|
25 | W !,X
|
---|
26 | W !!," FMS Name: "_$$FIELD(IEN,34.5)
|
---|
27 | W !!," Payment ADDRESS: "_$$FIELD(IEN,17.3)
|
---|
28 | W !,SPACE_$$FIELD(IEN,17.4)
|
---|
29 | W:$$FIELD(IEN,17.5)]"" !,SPACE_$$FIELD(IEN,17.5)
|
---|
30 | W:$$FIELD(IEN,17.6)]"" !,SPACE_$$FIELD(IEN,17.6)
|
---|
31 | S X=SPACE
|
---|
32 | S:$$FIELD(IEN,17.7)]"" X=X_$$FIELD(IEN,17.7)_", "
|
---|
33 | S:$$FIELD(IEN,17.8)]"" X=X_$$FIELD(IEN,17.8)_" "
|
---|
34 | 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))
|
---|
35 | W !,X
|
---|
36 | W !!,"PAYMENT CONTACT PERSON: "_$$FIELD(IEN,17)
|
---|
37 | W !," PAYMENT PHONE NUMBER: "_$$FIELD(IEN,7.2)
|
---|
38 | W !
|
---|
39 | S DIR(0)="E"
|
---|
40 | D ^DIR
|
---|
41 | K DIR
|
---|
42 | W !
|
---|
43 | G:Y'=1 REVEXIT
|
---|
44 | W @IOF
|
---|
45 | W !!," VENDOR NAME: "_$$FIELD(IEN,.01)
|
---|
46 | W ?70,"PAGE: 2"
|
---|
47 | W !!," FMS VENDOR CODE: "_$$FIELD(IEN,34)
|
---|
48 | W !," ALT-ADDR-IND: "_$$FIELD(IEN,35)
|
---|
49 | W !," TAX ID/SSN: "_$$FIELD(IEN,38)
|
---|
50 | W !," SSN/TAX ID IND: "_$$FIELD(IEN,39)
|
---|
51 | W !!," NON-RECURRING/"
|
---|
52 | W !," RECURRUNG VENDOR: "_$$FIELD(IEN,36)
|
---|
53 | W !!," 1099 VENDOR INDICATOR: "_$$FIELD(IEN,41)
|
---|
54 | W !," VENDOR TYPE: "_$$FIELD(IEN,44)
|
---|
55 | W !," DUN & BRADSTREET: "_$$FIELD(IEN,18.3)
|
---|
56 | W !
|
---|
57 | S DIR(0)="E"
|
---|
58 | S DIR("A")="Enter RETURN to continue"
|
---|
59 | D ^DIR
|
---|
60 | K DIR
|
---|
61 | REVEXIT S VALMBCK="R",VALMBG=1
|
---|
62 | REVQ Q
|
---|
63 | ;
|
---|
64 | EDIT ;EDIT THIS VENDOR
|
---|
65 | N PRCOI,PRCOIN,IEN
|
---|
66 | D EN^VALM2(XQORNOD(0),"OS")
|
---|
67 | S PRCOI=0
|
---|
68 | S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
|
---|
69 | S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI))
|
---|
70 | S IEN=+$P(PRCOIN,U,2)
|
---|
71 | D FULL^VALM1
|
---|
72 | W @IOF
|
---|
73 | S NAME=$P($G(^PRC(440,IEN,0)),U)
|
---|
74 | W:NAME]"" !!,NAME
|
---|
75 | D HILO^PRCFQ
|
---|
76 | S (DA,PRCFA("VEND"))=IEN D INFO^PRCFAC3 K PRCTMP D DOIT
|
---|
77 | G:$D(DIRUT)!(Y'=1) EDITEX
|
---|
78 | D SCREEN
|
---|
79 | L +^PRC(440,DA):5 E W !,$C(7),"Another user is editing this entry!" G EDITEX
|
---|
80 | ;K ^PRC(440.3,DA) S %X="^PRC(440,DA,",%Y="^PRC(440.3,DA," D %XY^%RCR
|
---|
81 | S DIE="^PRC(440,",DR="[PRCF FMS VENEDIT1B]"
|
---|
82 | D ^DIE K DIE,DR,ORDER
|
---|
83 | L -^PRC(440,PRCFA("VEND"))
|
---|
84 | EDITEX S VALMBCK="R",VALMBG=1
|
---|
85 | ; SEND VENDOR UPDATE INFORMATION TO DYNAMED **81**
|
---|
86 | I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1)=1,$D(IEN) D ONECHK^PRCVNDR(PRCFA("VEND"))
|
---|
87 | Q
|
---|
88 | ;
|
---|
89 | SEND ;SEND THIS VRQ TO AUSTIN
|
---|
90 | N PRCOI,PRCOIN,IEN
|
---|
91 | D EN^VALM2(XQORNOD(0),"OS")
|
---|
92 | S PRCOI=0
|
---|
93 | S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
|
---|
94 | S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI))
|
---|
95 | S IEN=+$P(PRCOIN,U,2)
|
---|
96 | D SEND^PRCHE1(IEN)
|
---|
97 | D INIT^PRCORV
|
---|
98 | S VALMBCK="R",VALMBG=1
|
---|
99 | Q
|
---|
100 | ;
|
---|
101 | DELETE ;DELETE THIS VENDOR REQUEST FROM THE LOCAL IFCAP SYSTEM
|
---|
102 | N PRCOI,PRCOIN,IEN,VRQ,COUNT
|
---|
103 | D EN^VALM2(XQORNOD(0),"OS")
|
---|
104 | S PRCOI=0
|
---|
105 | S PRCOI=$O(VALMY(PRCOI)) G:'PRCOI REVQ
|
---|
106 | S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI))
|
---|
107 | S IEN=+$P(PRCOIN,U,2)
|
---|
108 | S NAME=$P($G(^PRC(440,IEN,0)),U)
|
---|
109 | S DIR("A")="Do you want to delete "_NAME_" (YES/NO)"
|
---|
110 | S DIR(0)="Y"
|
---|
111 | S DIR("B")="NO"
|
---|
112 | D ^DIR
|
---|
113 | K DIR
|
---|
114 | G:Y'=1 NODELETE
|
---|
115 | S VRQ=$O(^PRCF(422.2,"B","123-VRQ-01",0))
|
---|
116 | S COUNT=$P(^PRCF(422.2,VRQ,0),U,2),COUNT=$S(COUNT-1>0:COUNT-1,1:0),$P(^PRCF(422.2,VRQ,0),U,2)=COUNT
|
---|
117 | K ^PRC(440.3,"AD",IEN,IEN)
|
---|
118 | K ^PRC(440.3,IEN)
|
---|
119 | D INIT^PRCORV
|
---|
120 | NODELETE S VALMBCK="R",VALMBG=1
|
---|
121 | Q
|
---|
122 | ;
|
---|
123 | FIELD(IEN,FIELD) ;FETCH EXTERNAL VALUE OF FIELD
|
---|
124 | ;FOR RECORD 'IEN' FROM FILE 440.3
|
---|
125 | S FIELD=$G(PRCORVP(440,IEN,FIELD,"E"))
|
---|
126 | Q FIELD
|
---|
127 | ;
|
---|
128 | DOIT ;FIND OUT IF USER WANTS TO EDIT VENDOR RECORD
|
---|
129 | W !
|
---|
130 | S DIR(0)="Y"
|
---|
131 | S DIR("A")="Edit the payment information on Vendor record"
|
---|
132 | S DIR("B")="YES"
|
---|
133 | S DIR("?")="Enter 'NO' or 'N' or '^' to exit this edit session."
|
---|
134 | S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue."
|
---|
135 | D ^DIR
|
---|
136 | K DIR
|
---|
137 | W !
|
---|
138 | Q
|
---|
139 | ;
|
---|
140 | SCREEN ; Control screen display
|
---|
141 | I $D(IOF) W @IOF
|
---|
142 | HDR ; Write Option Header
|
---|
143 | I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM,!
|
---|
144 | Q
|
---|