1 | PRCOER4 ;WIRMFO-EDI EXCEPTIONS REPORT ; [8/31/98 1:51pm]
|
---|
2 | ;;5.1;IFCAP;;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | W @IOF
|
---|
6 | D RT^PRCOER1 ;ask user date range
|
---|
7 | I $S('$G(PRCOBEG):1,'$G(PRCOSTOP):1,1:0) G STOP^PRCOER2
|
---|
8 | ;
|
---|
9 | S ZTSAVE("PRCOBEG")=""
|
---|
10 | S ZTSAVE("PRCOSTOP")=""
|
---|
11 | S ZTSAVE("SENDER")=""
|
---|
12 | S ZTRTN="START^PRCOER4"
|
---|
13 | S ZTDESC="EC/EDI Exceptions Report"
|
---|
14 | D ZIS^PRCOER2
|
---|
15 | I $G(POP) G STOP^PRCOER2
|
---|
16 | I $G(PRCOPOP) G STOP^PRCOER2
|
---|
17 | ;
|
---|
18 | START ; entry to generate Exceptions Report
|
---|
19 | ;
|
---|
20 | U IO
|
---|
21 | I $E(IOST,1,2)="C-" W @IOF
|
---|
22 | ; this section gathers all errors sent from Austin
|
---|
23 | D HED
|
---|
24 | D PRJ
|
---|
25 | I '$G(PRCOUT),$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR G QUIT:$G(DIRUT)
|
---|
26 | W @IOF
|
---|
27 | D HED
|
---|
28 | D POA
|
---|
29 | ;
|
---|
30 | QUIT K DUOUT,DIRUT,DTOUT,IT,PO,PRCO,CNT G STOP^PRCOER2 ;return to list manager control
|
---|
31 | ;
|
---|
32 | PRJ N I,J,PRCO
|
---|
33 | D HEDPRJ
|
---|
34 | I SENDER=0 S I=PRCOBEG F S I=$O(^PRC(443.75,"AL",2,"PRJ",I)) Q:'I!(I>PRCOSTOP)!($G(PRCOUT)) D
|
---|
35 | . S J=0 F S J=$O(^PRC(443.75,"AL",2,"PRJ",I,J)) Q:'J!($G(PRCOUT)) S PRCO(0)=$G(^PRC(443.75,J,0)),PRCO(1)=^(1) D DISPLAY S CNT=1
|
---|
36 | I SENDER>0 S I=PRCOBEG F S I=$O(^PRC(443.75,"AL1",2,SENDER,"PRJ",I)) Q:'I!(I>PRCOSTOP)!($G(PRCOUT)) D
|
---|
37 | . S J=0 F S J=$O(^PRC(443.75,"AL1",2,SENDER,"PRJ",I,J)) Q:'J!($G(PRCOUT)) S PRCO(0)=$G(^PRC(443.75,J,0)),PRCO(1)=^(1) D DISPLAY S CNT=1
|
---|
38 | I '$G(CNT) D NORECORD
|
---|
39 | Q
|
---|
40 | ;
|
---|
41 | DISPLAY ; Come here to show a PRJ exception to the user.
|
---|
42 | ;
|
---|
43 | W !,?1,$P(PRCO(0),U,2),?22,$P(PRCO(0),U,6),?36,$$FMTE^XLFDT($P(PRCO(1),U,2),2),?64,$E($P(PRCO(1),U,3),1,25)
|
---|
44 | W !?2,$P(PRCO(1),U,4),?30,$P(PRCO(1),U,6),?38,$P(PRCO(1),U,8),?50,$P(PRCO(1),U,9),?62,$P(PRCO(1),U,10),?73,$P(PRCO(1),U,14)
|
---|
45 | I $P(PRCO(1),U,5)]"" W !?4,$P(PRCO(1),U,5)
|
---|
46 | I $P(PRCO(1),U,7) W !?4,"Reject Reason Code: ",$P($G(^PRC(443.76,+$P(PRCO(1),U,7),0)),U,2)
|
---|
47 | D HANG Q:$G(PRCOUT)
|
---|
48 | I $Y+5>IOSL W @IOF D HED,HEDPRJ
|
---|
49 | Q
|
---|
50 | ;
|
---|
51 | POA N I,J,PRCO
|
---|
52 | K PRCOUT,CNT
|
---|
53 | D HEDPOA
|
---|
54 | S I=PRCOBEG F S I=$O(^PRC(443.75,"AM",3,"POA",I)) Q:'I!(I>PRCOSTOP)!($G(PRCOUT)) D
|
---|
55 | . S J=0 F S J=$O(^PRC(443.75,"AM",3,"POA",I,J)) Q:'J!($G(PRCOUT)) S PRCO(0)=$G(^PRC(443.75,J,0)),PRCO(1)=^(1) D
|
---|
56 | .. S PO=+$P(PRCO(0),U,8) Q:$G(^PRC(442,PO,0))']"" D DISPLAY1
|
---|
57 | I '$G(CNT) D NORECORD
|
---|
58 | Q
|
---|
59 | ;
|
---|
60 | DISPLAY1 ; Come here to show a POA exception to a user.
|
---|
61 | ;
|
---|
62 | Q:$P(PRCO(1),U,6)']"" S IT=$O(^PRC(442,PO,2,"B",$P(PRCO(1),U,6),0)) Q:IT=""
|
---|
63 | S PRCO(2)=$G(^PRC(442,+PO,2,+IT,0)),PRCO(3)=$G(^(2))
|
---|
64 | Q:$P($G(PRCO(3)),U,9)="AC"
|
---|
65 | Q:$P($G(PRCO(3)),U,11)="AC"
|
---|
66 | S CNT=1
|
---|
67 | W !?2,$P(PRCO(0),U,2),?26,$P(PRCO(1),U,6),?48,$P(^PRCD(420.5,+$P(PRCO(2),U,3),0),U,2)
|
---|
68 | W !?3,$P(PRCO(2),U,2),?15,$S($P(PRCO(3),U,12):$P(PRCO(3),U,12),1:$P(PRCO(3),U,10))
|
---|
69 | W ?27,$S($P(PRCO(3),U,11)]"":$$CODE($P(PRCO(3),U,11)),1:$$CODE($P(PRCO(3),U,9)))
|
---|
70 | D ERR
|
---|
71 | D HANG Q:$G(PRCOUT)
|
---|
72 | I $Y+5>IOSL W @IOF D HED,HEDPOA
|
---|
73 | Q
|
---|
74 | ;
|
---|
75 | HED ; used to print main header for exception report.
|
---|
76 | W !!
|
---|
77 | S HEADER=$S(SENDER=0:"EC/EDI EXCEPTION REPORT",1:"EC/EDI EXCEPTION REPORT for "_$P($G(^VA(200,SENDER,0)),U))
|
---|
78 | W $$CJ^XLFSTR(HEADER,$S($G(IOM):IOM,1:80)),!
|
---|
79 | W $$CJ^XLFSTR($$REPEAT^XLFSTR("-",$L(HEADER)),$S($G(IOM):IOM,1:80)),!
|
---|
80 | W !?2,"Date Range for Report: ",$$FMTE^XLFDT(PRCOBEG)_" to "_$$FMTE^XLFDT(PRCOSTOP),!
|
---|
81 | Q
|
---|
82 | HEDPRJ ; write header for PRJ data
|
---|
83 | W !,$$CJ^XLFSTR(">>>> PRJ EXCEPTIONS <<<<",$S($G(IOM):IOM,1:80))
|
---|
84 | W !!?1,"REFERENCE #",?22,"VENDOR ID",?36,"DATE/TIME PROCESSED",?59,"INCORRECT SEGMENT"
|
---|
85 | W !?2,"INCORRECT FIELD",?30,"LINE#",?38,"DESC-LINE#",?50,"DE-SEQ#",?62,"CO-SEQ#",?73,"SEQ #"
|
---|
86 | W !?4,"FIELD CONTENTS"
|
---|
87 | W !,$$REPEAT^XLFSTR("=",$S($G(IOM):IOM,1:80))
|
---|
88 | Q
|
---|
89 | ;
|
---|
90 | HEDPOA ; write header for POA exceptions
|
---|
91 | W !,$$CJ^XLFSTR(">>>> POA EXCEPTIONS <<<<",$S($G(IOM):IOM,1:80))
|
---|
92 | W !!?1,"REFERENCE #",?24,"LINE ITEM #",?47,"UNIT OF PURCHASE"
|
---|
93 | W !?2,"QTY ORDERED",?15,"QTY EXCEPTED",?29,"EXCEPTION REASON"
|
---|
94 | W !,$$REPEAT^XLFSTR("=",$S($G(IOM):IOM,1:80))
|
---|
95 | Q
|
---|
96 | ;
|
---|
97 | HANG ; call at end of screen if output sent to screen
|
---|
98 | ; returns 'PRCOUT'=1 if user enter '^'
|
---|
99 | N DIRUT,DUOUT,DTOUT
|
---|
100 | K PRCOUT
|
---|
101 | I $Y+5>IOSL,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR S:'Y PRCOUT=1 Q:$G(PRCOUT)
|
---|
102 | ;
|
---|
103 | ; I $Y+5>IOSL W @IOF D HED
|
---|
104 | ;
|
---|
105 | Q
|
---|
106 | ;
|
---|
107 | CODE(X) ; returns external value of set of codes from field 442.01,13
|
---|
108 | ; X = what is stored
|
---|
109 | I $G(X)']"" Q ""
|
---|
110 | N Y,C
|
---|
111 | S Y=X
|
---|
112 | S C=$P(^DD(442.01,13,0),U,2)
|
---|
113 | D Y^DIQ
|
---|
114 | Q Y
|
---|
115 | ;
|
---|
116 | ERR ; write out incoming processing errors
|
---|
117 | ;
|
---|
118 | Q:'$O(^PRC(443.75,J,"ERR",0))
|
---|
119 | W !?8,">>> Incoming processing errors <<<"
|
---|
120 | N I S I=0
|
---|
121 | F S I=$O(^PRC(443.75,J,"ERR",I)) Q:'I W !?2,"- ",$G(^(I,0))
|
---|
122 | Q
|
---|
123 | ;
|
---|
124 | NORECORD ; write no data to report
|
---|
125 | W !!?3,"No records meet the selection criteria.",!
|
---|
126 | Q
|
---|
127 | ;
|
---|
128 | PO ; display selected PURCHASE ORDER
|
---|
129 | S MESS="Enter the line number of the PO/RFQ"
|
---|
130 | D MSG^VALM10(MESS)
|
---|
131 | W !!!!
|
---|
132 | AGAIN W !,"LINE NUMBER: " R PONUM:DTIME
|
---|
133 | I PONUM["^"!(PONUM="") G FINI
|
---|
134 | I PONUM'?1.N!(PONUM<1) W !!,?6," Please enter the line number next to the PO/RFQ Number.",$C(7),! G AGAIN
|
---|
135 | I PONUM>VALMCNT W !!,?6," Response must be no greater than "_VALMCNT_".",$C(7),! G AGAIN
|
---|
136 | S PONUM1=$P($G(^PRC(443.75,"PRCOER",$J,PONUM)),U,2)
|
---|
137 | S PONUM2=$G(^PRC(443.75,PONUM1,0))
|
---|
138 | I PONUM2="" W !,"THE ENTRY IN FILE 443.75 IS MISSING" G FINI
|
---|
139 | S PRC("SITE")=$P($P(PONUM2,U,2),"-",1)
|
---|
140 | I $P(PONUM2,"-",3)="RFQ" W !!,?6," Please use option View RFQ [PRCHQ15] to review this line item.",$C(7),! G AGAIN
|
---|
141 | S D0=$P(PONUM2,U,8)
|
---|
142 | D CLEAR^VALM1
|
---|
143 | D ^PRCHDP1
|
---|
144 | FINI D PAUSE^VALM1
|
---|
145 | S VALMBCK="R"
|
---|
146 | Q
|
---|