source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRPKG.m@ 1046

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

initial load of WorldVistAEHR

File size: 971 bytes
RevLine 
[613]1PRCPRPKG ;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 <*>"
15DQ ; queue comes here
16 ; find errors
17 D PROCESS^PRCPRPK1
18 ; print errors
19 D PRINT^PRCPRPK2
20Q K ^TMP($J,"PRCPURS4"),^TMP($J,"PRCPRPKG") D ^%ZISC
21 Q
Note: See TracBrowser for help on using the repository browser.