Last change
on this file since 1093 was 613, checked in by George Lilly, 15 years ago |
initial load of WorldVistAEHR
|
File size:
971 bytes
|
Line | |
---|
1 | PRCPRPKG ;WISC/RFJ-packaging discrepancy report ;04 Oct 91
|
---|
2 | ;;5.1;IFCAP;;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
---|
5 | I "WP"'[PRCP("DPTYPE") W !,"THIS PROGRAM CAN ONLY BE USED BY THE WAREHOUSE OR PRIMARY INVENTORY POINTS." Q
|
---|
6 | N WHSESRCE,X,Y
|
---|
7 | S WHSESRCE=$O(^PRC(440,"AC","S",0)) I 'WHSESRCE W !!,"YOU DO NOT HAVE A VENDOR (FILE #440) ENTERED AS A SUPPLY WAREHOUSE.",! Q
|
---|
8 | ; get selected item list
|
---|
9 | D ITEMSEL^PRCPURS4
|
---|
10 | I '$O(^TMP($J,"PRCPURS4",0)),'$D(PRCPALLI) Q
|
---|
11 | S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D Q Q
|
---|
12 | . S ZTDESC="Packaging Discrepancy Report",ZTRTN="DQ^PRCPRPKG"
|
---|
13 | . S ZTSAVE("PRCP*")="",ZTSAVE("^TMP($J,""PRCPURS4"",")="",ZTSAVE("WHSESRCE")="",ZTSAVE("ZTREQ")="@"
|
---|
14 | W !!,"<*> please wait <*>"
|
---|
15 | DQ ; queue comes here
|
---|
16 | ; find errors
|
---|
17 | D PROCESS^PRCPRPK1
|
---|
18 | ; print errors
|
---|
19 | D PRINT^PRCPRPK2
|
---|
20 | Q K ^TMP($J,"PRCPURS4"),^TMP($J,"PRCPRPKG") D ^%ZISC
|
---|
21 | Q
|
---|
Note:
See
TracBrowser
for help on using the repository browser.