|
Last change
on this file since 619 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
971 bytes
|
| Rev | Line | |
|---|
| [613] | 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.
