source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOVL1.m@ 619

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

initial load of WorldVistAEHR
File size: 5.2 KB
Line 
1PRCOVL1 ;WISC/DJM/BGJ-IFCAP AR VENDOR EDIT ROUTINE CONTINUED ;[10/19/98 12:05pm]
2V ;;5.1;IFCAP;**7**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5PRINT ;PRINTING A COMPLETE REVIEW OF VENDOR ENTRY
6 ;
7 N %ZIS,AA,POP
8 D EN^VALM2(XQORNOD(0),"O")
9 Q:'$D(VALMY)
10 D FULL^VALM1
11 W @IOF
12 K IO("Q")
13 S %ZIS="MQ",%ZIS("A")="Select a printer: ",%ZIS("B")=""
14 S %ZIS("S")="S AA=$G(^%ZIS(1,Y,""SUBTYPE"")) I AA>0,$E($G(^%ZIS(2,AA,0)),1)=""P"""
15 D ^%ZIS
16 I POP W !!," No printer selected -- quitting." G PRINTQ
17 I $D(IO("Q")) K IO("Q") D G PRINTQ
18 . S ZTRTN="PRINT1^PRCOVL1"
19 . S ZTSAVE("VALMY(")=""
20 . S ZTSAVE("^TMP(""PRCOVL1"",$J,")=""
21 . S ZTDESC="Complete review of vender entry"
22 . D ^%ZTLOAD
23 . Q
24 ;
25PRINT1 ;ENTER HERE TO PRINT THE REPORT
26 N DIC,DA,DIQ,SPACE,%,%H,%I,X,Y,FIELD,PN,PRCOI,PRCOIN,IEN
27 S (PRCOI,PN)=0
28 ;GET THE IEN FOR EACH ENTRY SELECTED
29 F S PRCOI=$O(VALMY(PRCOI)) Q:PRCOI'>0 D
30 . S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
31 . S IEN=+$P(PRCOIN,U,2)
32 . S PN=PN+1
33 . D PRINT2
34 G PRINTQ
35 ;
36PRINT2 ;PRINT EACH ENTRY SELECTED HERE
37 K PRCOVL1
38 S DIC="^PRC(440,",DA=IEN,DR=".01:46",DIQ="PRCOVL1",DIQ(0)="E"
39 D EN^DIQ1
40 S $P(SPACE," ",24)=" "
41 U IO
42 W:$Y>0 @IOF
43 I $D(ZTQUEUED) W:PN>1 !
44 W !!,?9,"VENDOR Review"
45 W ?38
46 D NOW^%DTC
47 D YX^%DTC
48 W Y
49 W ?70,"PAGE: "_PN
50 W !!,?11,"Vendor Name: "_$$FIELD(IEN,.01)
51 W !,?6,"Ordering Address: "_$$FIELD(IEN,1)
52 W:$$FIELD(IEN,2)]"" !,SPACE_$$FIELD(IEN,2)
53 S X=" City,State,ZIP: "
54 S:$$FIELD(IEN,4.2)]"" X=X_$$FIELD(IEN,4.2)_", "
55 S:$$FIELD(IEN,4.4)]"" X=X_$$FIELD(IEN,4.4)_" "
56 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))
57 W !,X
58 W !!," FMS Name: "_$$FIELD(IEN,34.5)
59 W !!," * Payment ADDRESS: "_$$FIELD(IEN,17.3)
60 W !,SPACE,$$FIELD(IEN,17.4)
61 W:$$FIELD(IEN,17.5)]"" !,SPACE_$$FIELD(IEN,17.5)
62 W:$$FIELD(IEN,17.6)]"" !,SPACE_$$FIELD(IEN,17.6)
63 S X=" * City,State,ZIP: "
64 S:$$FIELD(IEN,17.7)]"" X=X_$$FIELD(IEN,17.7)_", "
65 S:$$FIELD(IEN,17.8)]"" X=X_$$FIELD(IEN,17.8)_" "
66 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))
67 W !,X
68 W !!,"PAYMENT CONTACT PERSON: "_$$FIELD(IEN,17)
69 W !," PAYMENT PHONE NUMBER: "_$$FIELD(IEN,7.2)
70 W !!,?7,"FMS VENDOR CODE: "_$$FIELD(IEN,34)
71 W !,?10,"ALT-ADDR-IND: "_$$FIELD(IEN,35)
72 W !," * TAX ID/SSN: "_$$FIELD(IEN,38)
73 W !," * SSN/TAX ID IND: "_$$FIELD(IEN,39)
74 W !!,?8,"NON-RECURRING/"
75 W !,?6,"RECURRING VENDOR: "_$$FIELD(IEN,36)
76 W !!," 1099 VENDOR INDICATOR: "_$$FIELD(IEN,41)
77 W !," * VENDOR TYPE: "_$$FIELD(IEN,44)
78 W !,?6,"DUN & BRADSTREET: "_$$FIELD(IEN,18.3)
79 W !!," * = REQUIRED FIELD"
80 Q
81 ;
82PRINTQ S VALMBCK="R",VALMBG=1
83 S:$D(ZTQUEUED) ZTREQ="@"
84 D ^%ZISC
85PRINTQ1 Q
86 ;
87FIELD(IEN,FIELD) ;FETCH EXTERNAL VALUE OF FIELD
88 ;FOR RECORD 'IEN' FROM FILE 440
89 S FIELD=$G(PRCOVL1(440,IEN,FIELD,"E"))
90 Q FIELD
91 Q
92 ;
93VRQ ; SEND THIS ENTRY TO VRQ REVIEW OR AUSTIN, AS NEEDED.
94 ; DO THIS ONLY FOR THOSE RECORDS IN THE "AR" NODE THAT ARE SET
95 ; TO "OK" IN THE OK FIELD (#53).
96 D EN^VALM2(XQORNOD(0),"OS")
97 S PRCOI=0
98 S PRCOI=$O(VALMY(PRCOI))
99 G:'PRCOI VRQEX
100 S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
101 S IEN=+$P(PRCOIN,U,2)
102 K PRCORVP
103 S DIC="^PRC(440.3,"
104 S DA=IEN
105 S DR="50:54"
106 S DIQ="PRCORVP"
107 S DIQ(0)="E"
108 D EN^DIQ1
109 S OK=$$FIELD1(IEN,53)
110 I OK="GOOD" W !!,"This record in now properly vendorized. You may delete it." D PAUSE G VRQEX
111 S SENT=$$FIELD1(IEN,54)
112 I SENT]"" W !!,"This record is sent. It needs to be removed." D PAUSE G VRQEX
113 I OK'="OK" W !,"This entry can not become a VRQ yet. Re-edit it." D PAUSE G VRQEX
114 S SITE=$$FIELD1(IEN,52)
115 S FISCAL=$G(^PRC(411,SITE,9))
116 I $P(FISCAL,U,3)="Y" D D ADD G VRQEX
117 . S FLAG=1
118 . S DIE="^PRC(440.3,"
119 . S SENT="SENT"
120 . S DR="47///^S X=FLAG;48///^S X=IEN;49///^S X=SITE;54///^S X=SENT"
121 . D ^DIE
122 . Q
123 ;
124 ; SINCE THIS VENDOR WON'T BE REVIEWED BY FISCAL LETS SEND THE VRQ
125 ; TO AUSTIN.
126 ;
127 D VRQS^PRCOVTST(IEN,SITE)
128 S DIE="^PRC(440.3,"
129 S SENT="SENT"
130 S DR="54///^S X=SENT"
131 D ^DIE
132 D ADD
133 ;
134VRQEX ; NOW THAT THE VRQ IS SENT LETS EXIT THIS PROTOCOL
135 S VALMBCK="R",VALMBG=1
136 Q
137 ;
138ADD ; UPDATE LIST MANAGER LINE NOTEING THAT THIS RECORD WAS SENT.
139 ;
140 S X=@VALMAR@(PRCOI,0)
141 S SENT="SENT"
142 S X=$$SETFLD^VALM1(SENT,X,"SENT")
143 S @VALMAR@(PRCOI,0)=X
144 Q
145 ;
146PAUSE ; LET USER READ MESSAGE, THEN CONTINUE.
147 S DIR(0)="E"
148 S DIR("A")="Enter RETURN to continue"
149 D ^DIR
150 K DIR
151 Q
152 ;
153FIELD1(IEN,FIELD) ;
154 ; FETCH EXTERNAL VALUE OF FIELD.
155 ; FOR RECORD 'IEN' FROM FILE 440.3.
156 S FIELD=$G(PRCORVP(440.3,IEN,FIELD,"E"))
157 Q FIELD
158 ;
159OUT ; REMOVE ONE RECORD FROM THE 'AR EDIT LIST'.
160 D EN^VALM2(XQORNOD(0),"OS")
161 S PRCOI=0
162 S PRCOI=$O(VALMY(PRCOI))
163 G:'PRCOI VRQEX
164 S PRCOIN=$G(^TMP("PRCOVL",$J,PRCOI))
165 S IEN=+$P(PRCOIN,U,2)
166 S OK=$P($G(^PRC(440.3,IEN,"AR")),U,4)
167 G:OK="GOOD" OUT1
168 I OK="" W !!,"This record needs to be edited first." D PAUSE G VRQEX
169 S SENT=$P($G(^PRC(440.3,IEN,"AR")),U,5)
170 I SENT="" W !!,"This record needs to be sent first." D PAUSE G VRQEX
171OUT1 S FLAG=1
172 S DIE="^PRC(440.3,"
173 S DA=IEN
174 S DR="50///@;51///@;52///@;53///@;54///@"
175 D ^DIE
176 S OUT=$O(^PRCF(422.2,"B","AR-EDIT-01",0))
177 S COUNT=$P(^PRCF(422.2,OUT,0),U,2)
178 S COUNT=$S(COUNT-1>0:COUNT-1,1:0)
179 S $P(^PRCF(422.2,OUT,0),U,2)=COUNT
180 I OK="GOOD" K ^PRC(440.3,IEN)
181 D INITA^PRCOVL
182 G VRQEX
Note: See TracBrowser for help on using the repository browser.