source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCORV1.m@ 1800

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

initial load of WorldVistAEHR

File size: 4.3 KB
RevLine 
[613]1PRCORV1 ;WISC/DJM/BGJ/AS-IFCAP VRQ REVIEW ROUTINE, CONTINUED ;3/8/05
2V ;;5.1;IFCAP;**7,81**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4REV ;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
61REVEXIT S VALMBCK="R",VALMBG=1
62REVQ Q
63 ;
64EDIT ;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"))
84EDITEX 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 ;
89SEND ;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 ;
101DELETE ;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
120NODELETE S VALMBCK="R",VALMBG=1
121 Q
122 ;
123FIELD(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 ;
128DOIT ;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 ;
140SCREEN ; Control screen display
141 I $D(IOF) W @IOF
142HDR ; Write Option Header
143 I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM,!
144 Q
Note: See TracBrowser for help on using the repository browser.