source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOER.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1PRCOER ;WISC/DJM-EDI REPORTS USING LIST MANAGER ; [10/20/98 11:58am]
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for PRCO EDI REPORTS
6 ; First lets see if there is anything to report. If not - exit.
7 Q:$G(PRCOFLG)=-1
8 N LIST,LIST1,LIST2,PO,PRCO
9 S LIST=""
10 S LIST=$O(^PRC(443.75,"AC",LIST))
11 S LIST1=""
12 S LIST1=$O(^PRC(443.75,"AF",LIST1))
13 S LIST2=""
14 S LIST2=$O(^PRC(443.75,"AO",LIST2))
15 I LIST="",LIST1="",LIST2="" G NOTHING
16 N X
17 I '$D(IOF)!('$G(IOST(0))) S IOP="HOME" D ^%ZIS K IOP
18 S X="IORVON;IORVOFF" D ENDR^%ZISS
19 S PRCO("RV1")=$G(IORVON)
20 S PRCO("RV0")=$G(IORVOFF)
21 S PRCO("XY")="N DX,DY S (DX,DY)=0 "_$G(^%ZOSF("XY"))
22 D EN^VALM("PRCO EDI REPORTS")
23 Q
24 ;
25HDR ; -- header code
26 S VALMHDR(1)="EDI Transactions from IFCAP Reports"
27 I SENDER>0 D
28 . S NAME=$P($G(^VA(200,SENDER,0)),U)
29 . S VALMHDR(1)=VALMHDR(1)_" Sender is "_NAME
30 . Q
31 Q
32 ;
33INIT ; -- init variables and list array
34 N COUNT,DATE,LINENO,LIST,LIST0,LIST1,LIST2,ERROR,REJECT,RFQ,TXT,TYPE,VENDOR,VENDOR1
35 K ^PRC(443.75,"PRCOER",$J)
36 S LIST=""
37 S LIST=$O(^PRC(443.75,"AC",LIST))
38 S LIST1=""
39 S LIST1=$O(^PRC(443.75,"AF",LIST1))
40 S LIST2=""
41 S LIST2=$O(^PRC(443.75,"AO",LIST2))
42 I LIST="",LIST1="",LIST2="" G NOTHING
43 D CLEAN^VALM10
44 S COUNT=0
45 S LINENO=0
46 G:SENDER>0 INIT0
47 ;
48 ; First list all PROGRESS LEVEL 3 records.
49 ;
50 S LIST=""
51 F S LIST=$O(^PRC(443.75,"AM",3,LIST)) Q:LIST="" D
52 . S LIST0=""
53 . F S LIST0=$O(^PRC(443.75,"AM",3,LIST,LIST0),-1) Q:LIST0="" D
54 . . S LIST1=""
55 . . F S LIST1=$O(^PRC(443.75,"AM",3,LIST,LIST0,LIST1)) Q:LIST1="" D
56 . . . S LIST2=$G(^PRC(443.75,LIST1,0))
57 . . . Q:LIST2=""
58 . . . D INIT1
59 . . . Q
60 . . Q
61 . Q
62 ;
63 ; Next list all PROGRESS LEVEL 2 records.
64 ;
65 S LIST=""
66 F S LIST=$O(^PRC(443.75,"AL",2,LIST)) Q:LIST="" D
67 . S LIST0=""
68 . F S LIST0=$O(^PRC(443.75,"AL",2,LIST,LIST0),-1) Q:LIST0="" D
69 . . S LIST1=""
70 . . F S LIST1=$O(^PRC(443.75,"AL",2,LIST,LIST0,LIST1)) Q:LIST1="" D
71 . . . S LIST2=$G(^PRC(443.75,LIST1,0))
72 . . . Q:LIST2=""
73 . . . D INIT1
74 . . . Q
75 . . Q
76 . Q
77 ;
78 ; Last list all PROGRESS LEVEL 1 records.
79 ;
80 S LIST=""
81 F S LIST=$O(^PRC(443.75,"AJ",1,LIST)) Q:LIST="" D
82 . S LIST0=""
83 . F S LIST0=$O(^PRC(443.75,"AJ",1,LIST,LIST0),-1) Q:LIST0="" D
84 . . S LIST1=""
85 . . F S LIST1=$O(^PRC(443.75,"AJ",1,LIST,LIST0,LIST1)) Q:LIST1="" D
86 . . . S LIST2=$G(^PRC(443.75,LIST1,0))
87 . . . Q:LIST2=""
88 . . . D INIT1
89 . . . Q
90 . . Q
91 . Q
92 ;
93 ; Now lets show the list to the users.
94 ;
95 S VALMCNT=COUNT
96 Q
97 ;
98INIT0 ; Come here if the user selected one sender to view.
99 ;
100 ; First list all PROGRESS LEVEL 3 records for SENDER.
101 ;
102 S LIST=""
103 F S LIST=$O(^PRC(443.75,"AM1",3,SENDER,LIST)) Q:LIST="" D
104 . S LIST0=""
105 . F S LIST0=$O(^PRC(443.75,"AM1",3,SENDER,LIST,LIST0),-1) Q:LIST0="" D
106 . . S LIST1=""
107 . . F S LIST1=$O(^PRC(443.75,"AM1",3,SENDER,LIST,LIST0,LIST1)) Q:LIST1="" D
108 . . . S LIST2=$G(^PRC(443.75,LIST1,0))
109 . . . Q:LIST2=""
110 . . . D INIT1
111 . . . Q
112 . . Q
113 . Q
114 ;
115 ; Next list all PROGRESS LEVEL 2 records for SENDER.
116 ;
117 S LIST=""
118 F S LIST=$O(^PRC(443.75,"AL1",2,SENDER,LIST)) Q:LIST="" D
119 . S LIST0=""
120 . F S LIST0=$O(^PRC(443.75,"AL1",2,SENDER,LIST,LIST0),-1) Q:LIST0="" D
121 . . S LIST1=""
122 . . F S LIST1=$O(^PRC(443.75,"AL1",2,SENDER,LIST,LIST0,LIST1)) Q:LIST1="" D
123 . . . S LIST2=$G(^PRC(443.75,LIST1,0))
124 . . . Q:LIST2=""
125 . . . D INIT1
126 . . . Q
127 . . Q
128 . Q
129 ;
130 ; Last list all PROGRESS LEVEL 1 records for SENDER.
131 ;
132 S LIST=""
133 F S LIST=$O(^PRC(443.75,"AJ1",1,SENDER,LIST)) Q:LIST="" D
134 . S LIST0=""
135 . F S LIST0=$O(^PRC(443.75,"AJ1",1,SENDER,LIST,LIST0),-1) Q:LIST0="" D
136 . . S LIST1=""
137 . . F S LIST1=$O(^PRC(443.75,"AJ1",1,SENDER,LIST,LIST0,LIST1)) Q:LIST1="" D
138 . . . S LIST2=$G(^PRC(443.75,LIST1,0))
139 . . . Q:LIST2=""
140 . . . D INIT1
141 . . . Q
142 . . Q
143 . Q
144 ;
145 ; Now lets show the list to the users.
146 ;
147 S VALMCNT=COUNT
148 Q
149 ;
150INIT1 ; ENTER DATA FROM THE RECORD CHOOSEN.
151 ;
152 S PO=$P(LIST2,U,2)
153 S TXT=+$P(LIST2,U,3)
154 S RFQ=+$P(LIST2,U,10)
155 S RFQ=$S(RFQ=0:"O",1:"C")
156 S TYPE=$P(LIST2,U,4)
157 S TXT=$S(TYPE="TXT":TXT,TYPE="RFQ":RFQ,1:"")
158 S VENDOR=$P(LIST2,U,6)
159 S DATE=$P($P(LIST2,U,7),".",1)
160 ;
161 I TYPE="PHA" D
162 . I '$D(^PRC(440,"AG",VENDOR)) S VENDOR="Not Found" Q
163 . S VENDOR=$O(^PRC(440,"AG",VENDOR,""))
164 . S VENDOR=$E($P($G(^PRC(440,VENDOR,0)),U),1,30)
165 . I VENDOR']"" S VENDOR="Not Found"
166 . Q
167 ;
168 I TYPE'="PHA" D
169 . I VENDOR="PUBLIC" Q
170 . S:$E(VENDOR,1,3)'="DUN" VENDOR="DUN"_VENDOR
171 . S VENDOR1=$O(^PRC(440,"DB",VENDOR,""))
172 . I VENDOR1>0 S VENDOR=$E($P($G(^PRC(440,VENDOR1,0)),U),1,30) Q
173 . S VENDOR1=$O(^PRC(444.1,"DB",VENDOR,""))
174 . I VENDOR1>0 S VENDOR=$E($P($G(^PRC(444.1,VENDOR1,0)),U),1,30) Q
175 . I VENDOR']"" S VENDOR="Not Found"
176 . Q
177 ;
178 S LIST2=$G(^PRC(443.75,LIST1,1))
179 S REJECT=$P(LIST2,U,7)
180 S ERROR=$P(LIST2,U,12)
181 S:$P(LIST2,U,1)]"" TYPE=$P(LIST2,U,1)
182 S:$P(LIST2,U,15)]"" TYPE=$P(LIST2,U,15)
183 ;
184 ; IN THE NEXT LINE THE $S DEFAULT - THE 1:PART AT THE END- WILL BE
185 ; 'POA' IN THE TYPE VARIABLE.
186 ;
187 S DATE=$S(",PHA,RFQ,TXT,"[TYPE:DATE,",ACT,PRJ,"[TYPE:$P($P(LIST2,U,2),".",1),1:$P($P(LIST2,U,16),"."))
188 S DATE=+$E(DATE,4,5)_"/"_+$E(DATE,6,7)_"/"_(+$E(DATE,1,3)+1700)
189 S COUNT=COUNT+1
190 S X=$$SETFLD^VALM1(COUNT,"","NUMBER")
191 S X=$$SETFLD^VALM1(PO,X,"PO")
192 S X=$$SETFLD^VALM1(TXT,X,"TXT/RFQ")
193 S X=$$SETFLD^VALM1(TYPE,X,"TYPE")
194 S X=$$SETFLD^VALM1(VENDOR,X,"VENDOR")
195 S X=$$SETFLD^VALM1(REJECT,X,"REJECT")
196 S X=$$SETFLD^VALM1(ERROR,X,"ERROR")
197 S X=$$SETFLD^VALM1(DATE,X,"DATE")
198 S LINENO=LINENO+1
199 D SET^VALM10(COUNT,X,LINENO)
200 S ^PRC(443.75,"PRCOER",$J,LINENO)=COUNT_"^"_LIST1
201 Q
202 ;
203HELP ; -- help code
204 I X["??" G HELP1
205 ;
206 D EN^DDIOL("Select one of the valid actions above, or enter '??' for extended help.","","!")
207 D PAUSE
208 Q
209HELP1 ; DISPLAY LIST MANAGER STANDARD HELP SCREEN.
210 Q
211 ;
212PAUSE N DIR,DIRUT,DUOUT,DTOUT
213 S DIR("A")="Enter RETURN to continue"
214 S DIR(0)="E"
215 D ^DIR
216 Q
217 ;
218EXIT ; -- exit code
219 D CLEAN^VALM10
220 Q
221 ;
222NOTHING ; Come here if there are no transaction records to report.
223 D EN^DDIOL("There are no records to report on at this time.","","!!?5")
224 G PAUSE
Note: See TracBrowser for help on using the repository browser.