source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPAGPV.m@ 724

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

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1PRCPAGPV ;WISC/RFJ-autogen primary or whse order (select vendor) ;11 Dec 92
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7GETVEND ; select vendors
8 ; returns tmp global of vendors selected or de-selected;
9 ; vendall if all vendors selected (can be used in combination
10 ; with the tmp global); $g(prcpexit) to exit autogen.
11 N %,PRCPFLAG,V,VENDOR,VENDORNM,X,Y
12 K PRCPEXIT,VENDALL
13 D ALLVEND I $G(PRCPFLAG) S PRCPEXIT=1 Q
14 F D I $G(PRCPFLAG) Q
15 . I $O(^TMP($J,"PRCPAG","VY",0))!($G(VENDALL)) D
16 . . W !!," Currently selected vendors:",!," "
17 . . I $G(VENDALL) W "<< ALL VENDORS >>"
18 . . E S V=0 F S V=$O(^TMP($J,"PRCPAG","VY",V)) Q:'V S %=$E(^(V),1,20),%=%_$E(" ",$L(%),20) W:$X>70 !," " W %," "
19 . . W !," You can DE-select one of the above vendors by reselecting it."
20 . I $O(^TMP($J,"PRCPAG","VN",0)) D
21 . . W !!," Currently DE-selected vendors:",!," "
22 . . S V=0 F S V=$O(^TMP($J,"PRCPAG","VN",V)) Q:'V S %=$E(^(V),1,20),%=%_$E(" ",$L(%),20) W:$X>70 !," " W %," "
23 . . W !," You can RE-select one of the above vendors by reselecting it."
24 . W !!,"Select the name of the vendor supplying this primary, '^' to exit."
25 . S VENDOR=$$VENDOR I VENDOR<0 S (PRCPFLAG,PRCPEXIT)=1 Q
26 . S VENDORNM=$P($G(^PRC(440,VENDOR,0)),"^")
27 . I VENDOR=0,'$O(^TMP($J,"PRCPAG","VY",0)),'$G(VENDALL) D ALLVEND S:$G(PRCPFLAG) PRCPEXIT=1 Q
28 . I VENDOR=0 S PRCPFLAG=1 Q
29 . I $G(VENDALL),'$D(^TMP($J,"PRCPAG","VN",VENDOR)) K ^TMP($J,"PRCPAG","VY",VENDOR) S ^TMP($J,"PRCPAG","VN",VENDOR)=VENDORNM W !?10,"DE-selected !" Q
30 . I $D(^TMP($J,"PRCPAG","VY",VENDOR)) K ^TMP($J,"PRCPAG","VY",VENDOR) S ^TMP($J,"PRCPAG","VN",VENDOR)=VENDORNM W !?10,"DE-selected !" Q
31 . I $D(^TMP($J,"PRCPAG","VN",VENDOR)) K ^(VENDOR) S ^TMP($J,"PRCPAG","VY",VENDOR)=VENDORNM W !?10,"RE-selected !" Q
32 . S ^TMP($J,"PRCPAG","VY",VENDOR)=VENDORNM W !?10,"selected !"
33 I $G(PRCPEXIT) Q
34 I $G(VENDALL) K ^TMP($J,"PRCPAG","VY")
35 I '$G(VENDALL),'$O(^TMP($J,"PRCPAG","VY",0)) W !!,"NO VENDORS SELECTED." S PRCPEXIT=1 Q
36 Q
37 ;
38 ;
39VENDOR() ; select vendor
40 N DIC,X,Y
41 S DIC="^PRC(440,",DIC("S")="I '$P($G(^(10)),U,5)",DIC(0)="QEAM",PRCPPRIV=1 D ^DIC K PRCPPRIV,DIC
42 Q $S($G(X)["^":-1,Y<0:0,1:+Y)
43 ;
44 ;
45ALLVEND ; select all vendors
46 K VENDALL,PRCPFLAG
47 S XP="Do you want to select ALL vendors",XH="Enter 'YES' to auto-generate for ALL vendors,",XH(1)="enter 'NO' to auto-generate selectable vendors, or '^' to exit."
48 W ! S %=$$YN^PRCPUYN(1)
49 I %=2 Q
50 I %=1 S VENDALL=1 Q
51 S PRCPFLAG=1 Q
Note: See TracBrowser for help on using the repository browser.