source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAGP0.m@ 1389

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

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1PRCPAGP0 ;WISC/RFJ-autogenerate primary or warehouse order ;11 Dec 92
2 ;;5.1;IFCAP;**108**;Oct 20, 2000;Build 10
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 D ^PRCPUSEL Q:'$G(PRCP("I"))
5 I "PW"'[PRCP("DPTYPE") W !!,"THIS OPTION CAN ONLY BE USED BY A PRIMARY OR WHSE INVENTORY POINT." Q
6 N %,G,GROUP,GROUPALL,GROUPNM,PRCPEXIT,PRCPFLAG,PRCPREPN,VENDALL,WHSE,X,Y
7 S WHSE=+$O(^PRC(440,"AC","S",0)) I 'WHSE W !!,"WAREHOUSE VENDOR HAS NOT BEEN CREATED IN VENDOR FILE." Q
8 ;
9 ; get repetitive item list number
10 S %="========== PART 1: REPETITIVE ITEM LIST NUMBER ==========" W !!?(80-$L(%)\2),%
11 S PRCPREPN=$$GETRIL^PRCPAGPR I PRCPREPN="" Q
12 ;
13 ; select group categories
14 S %="========== PART 2A: SELECTION OF GROUP CATEGORIES ==========" W !!?(80-$L(%)\2),%
15 W !!,"Selected group categories and vendors will be used to auto-generate the order."
16 K ^TMP($J,"PRCPAG") D ALLGRP I $G(PRCPFLAG) Q
17 F D I $G(PRCPFLAG) Q
18 . I $O(^TMP($J,"PRCPAG","GY",0))!($G(GROUPALL)) D
19 . . W !!," Currently selected group categories:",!," "
20 . . I $G(GROUPALL) W "<< ALL GROUP CATEGORIES >>"
21 . . E S G=0 F S G=$O(^TMP($J,"PRCPAG","GY",G)) Q:'G S %=$E(^(G),1,20),%=%_$E(" ",$L(%),20) W:$X>70 !," " W %," "
22 . . W !," You can DE-select one of the above group categories by reselecting it."
23 . I $O(^TMP($J,"PRCPAG","GN",0)) D
24 . . W !!," Currently DE-selected group categories:",!," "
25 . . S G=0 F S G=$O(^TMP($J,"PRCPAG","GN",G)) Q:'G S %=$E(^(G),1,20),%=%_$E(" ",$L(%),20) W:$X>70 !," " W %," "
26 . . W !," You can RE-select one of the above group categories by reselecting it."
27 . W !!,"Select the name of the group category created for this primary, '^' to exit."
28 . S GROUP=$$GROUP^PRCPEGRP(PRCP("I"),"") I GROUP<0 S (PRCPFLAG,PRCPEXIT)=1 Q
29 . S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
30 . I GROUP=0,'$O(^TMP($J,"PRCPAG","GY",0)),'$G(GROUPALL) D ALLGRP S:$G(PRCPFLAG) PRCPEXIT=1 Q
31 . I GROUP=0 S PRCPFLAG=1 Q
32 . I $G(GROUPALL),'$D(^TMP($J,"PRCPAG","GN",GROUP)) K ^TMP($J,"PRCPAG","GY",GROUP) S ^TMP($J,"PRCPAG","GN",GROUP)=GROUPNM W !?10,"DE-selected !" Q
33 . I $D(^TMP($J,"PRCPAG","GY",GROUP)) K ^TMP($J,"PRCPAG","GY",GROUP) S ^TMP($J,"PRCPAG","GN",GROUP)=GROUPNM W !?10,"DE-selected !" Q
34 . I $D(^TMP($J,"PRCPAG","GN",GROUP)) K ^(GROUP) S ^TMP($J,"PRCPAG","GY",GROUP)=GROUPNM W !?10,"RE-selected !" Q
35 . S ^TMP($J,"PRCPAG","GY",GROUP)=GROUPNM W !?10,"selected !"
36 I $G(PRCPEXIT) D Q Q
37 I $G(GROUPALL) K ^TMP($J,"PRCPAG","GY")
38 I '$G(GROUPALL),'$O(^TMP($J,"PRCPAG","GY",0)) W !!,"NO GROUP CATEGORIES SELECTED." D Q Q
39 ;
40 ; select vendors
41 S %="========== PART 2B: SELECTION OF VENDORS ==========" W !!?(80-$L(%)\2),%
42 S VENDALL=1
43 I $G(GROUPALL),'$O(^TMP($J,"PRCPAG","GN",0)) D GETVEND^PRCPAGPV I $G(PRCPEXIT) D Q Q
44 ;
45 ; start running autogen
46 I '$G(VENDALL),'$O(^TMP($J,"PRCPAG","VY",0)) W !!,"NO VENDORS SELECTED." D Q Q
47 I $G(VENDALL),'$O(^TMP($J,"PRCPAG","VN",0)) W !!,"<<< NOTE: Auto-generating for ALL vendors."
48 S %="========== PART 3: START AUTO-GENERATION ==========" W !!?(80-$L(%)\2),%
49 S XP="ARE YOU SURE YOU WANT TO START AUTO-GENERATION",XH="Enter 'YES' to start auto-generating the order, 'NO' or '^' to exit."
50 W !! I $$YN^PRCPUYN(1)=1 D START^PRCPAGP1
51Q K ^TMP($J,"PRCPAG") Q
52 ;
53 ;
54ALLGRP ; select all group categories
55 K GROUPALL,PRCPFLAG
56 S XP="Do you want to select ALL group categories",XH="Enter 'YES' to auto-generate for ALL inventory items selectable by vendor,",XH(1)="enter 'NO' to auto-generate selectable group category items not selectable by"
57 S XH(2)="vendor, or enter '^' to exit."
58 W ! S %=$$YN^PRCPUYN(1)
59 I %=2 Q
60 I %=1 S GROUPALL=1 Q
61 S PRCPFLAG=1 Q
Note: See TracBrowser for help on using the repository browser.