| 1 | PRCPAGPV ;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 | ;
|
|---|
| 7 | GETVEND ; 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 | ;
|
|---|
| 39 | VENDOR() ; 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 | ;
|
|---|
| 45 | ALLVEND ; 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
|
|---|
