| 1 | PRCPAGS0 ;WISC/RFJ-autogenerate secondary order ;01 Dec 92
|
|---|
| 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 PRCP("DPTYPE")'="S" W !!,"THIS OPTION CAN ONLY BE USED BY SECONDARY INVENTORY POINTS." Q
|
|---|
| 6 | N %,D,INVPT,PRCPEXIT,PRCPFLAG,PRCPFNON,PRCPFONE,V,X,Y
|
|---|
| 7 | S %="========== PART 1: SELECTION OF DISTRIBUTION INVENTORY POINTS ==========" W !!?(80-$L(%)\2),%
|
|---|
| 8 | W !!,"Selected distribution inventory points will be used to auto-generate the order."
|
|---|
| 9 | K ^TMP($J,"PRCPAG")
|
|---|
| 10 | S INVPT=$$FROMCHEK^PRCPUDPT(PRCP("I"),0)
|
|---|
| 11 | I $G(PRCPFNON) W !!,"THIS INVENTORY POINT IS NOT STOCKED BY A PRIMARY INVENTORY POINT." Q
|
|---|
| 12 | I $G(PRCPFONE) S %=$$INVNAME^PRCPUX1(INVPT) W !!,"This inventory point is only stocked by: ",% S ^TMP($J,"PRCPAG","V",INVPT)=% G AUTOGEN
|
|---|
| 13 | K PRCPFLAG D ALL Q:$G(PRCPFLAG)
|
|---|
| 14 | F D Q:$G(PRCPFLAG)
|
|---|
| 15 | . I $O(^TMP($J,"PRCPAG","V",0)) D
|
|---|
| 16 | . . W !!!," Currently selected distribution inventory points:",!," "
|
|---|
| 17 | . . S V=0 F S V=$O(^TMP($J,"PRCPAG","V",V)) Q:'V S %=$E(^(V),1,20),%=%_$E(" ",$L(%),20) W:$X>70 !," " W %," "
|
|---|
| 18 | . . W !," You can DE-select one of the above distribution points by reselecting it."
|
|---|
| 19 | . W !!,"Select the name of the inventory point that stocks your secondary, '^' to exit."
|
|---|
| 20 | . I '$O(^TMP($J,"PRCPAG","V",0)) W !,"Press return without a selection to select ALL distribution inventory points."
|
|---|
| 21 | . S Y=$$FROM^PRCPUDPT(PRCP("I")) I Y["^" S (PRCPEXIT,PRCPFLAG)=1 Q
|
|---|
| 22 | . I 'Y,'$O(^TMP($J,"PRCPAG","V",0)) D ALL S:$G(PRCPFLAG) PRCPEXIT=1 Q
|
|---|
| 23 | . I 'Y S PRCPFLAG=1 Q
|
|---|
| 24 | . I $D(^TMP($J,"PRCPAG","V",+Y)) K ^(+Y) W !?10,"DE-selected !" Q
|
|---|
| 25 | . S ^TMP($J,"PRCPAG","V",+Y)=$$INVNAME^PRCPUX1(Y) W !?10,"selected !"
|
|---|
| 26 | I $G(PRCPEXIT) D Q Q
|
|---|
| 27 | ;
|
|---|
| 28 | AUTOGEN ; start autogen with selected distribution points
|
|---|
| 29 | S %="========== PART 2: START AUTO-GENERATION ==========" W !!?(80-$L(%)\2),%
|
|---|
| 30 | I '$O(^TMP($J,"PRCPAG","V",0)) W !!,"NO DISTRIBUTION INVENTORY POINTS SELECTED." Q
|
|---|
| 31 | W !!,"Auto-generating from the following distribution inventory points:",!
|
|---|
| 32 | S V=0 F S V=$O(^TMP($J,"PRCPAG","V",V)) Q:'V S %=$E(^(V),1,20),%=%_$E(" ",$L(%),20) W:$X>70 ! W %," "
|
|---|
| 33 | ;
|
|---|
| 34 | ; check to see if there are outstanding distribution orders
|
|---|
| 35 | ; unreleased
|
|---|
| 36 | K PRCPFLAG S X=0 F S X=$O(^PRCP(445.3,"AD",PRCP("I"),X)) Q:'X S D=$G(^PRCP(445.3,X,0)) I D'="",$P(D,"^",6)="" D
|
|---|
| 37 | . I '$G(PRCPFLAG) W !!,"The following distribution orders have not been released for filling:"
|
|---|
| 38 | . W !?5,$P(D,"^"),?15,"primary ",$$INVNAME^PRCPUX1(+$P(D,"^",2)),?50,"Date: ",$E($P(D,"^",4),4,5),"-",$E($P(D,"^",4),6,7),"-",$E($P(D,"^",4),2,3)
|
|---|
| 39 | . S PRCPFLAG=1
|
|---|
| 40 | S %=1 I $G(PRCPFLAG) S %=2 W !,"Since the DUE-INS have not been created for the above orders, you may want to",!,"check them before continuing with auto-generating the new distribution order."
|
|---|
| 41 | S XP="ARE YOU SURE YOU WANT TO START AUTO-GENERATION",XH="Enter 'YES' to start auto-generating the order, 'NO' or '^' to exit."
|
|---|
| 42 | W !! I $$YN^PRCPUYN(%)=1 D START^PRCPAGS1
|
|---|
| 43 | Q K ^TMP($J,"PRCPAG") Q
|
|---|
| 44 | ;
|
|---|
| 45 | ;
|
|---|
| 46 | ALL ; select all distribution inventory points
|
|---|
| 47 | S XP=" Do you want to select ALL distribution inventory points",XH=" Enter 'YES' to autogen from ALL distribution inventory points,",XH(1)=" 'NO' or '^' to exit."
|
|---|
| 48 | W ! S %=$$YN^PRCPUYN(1)
|
|---|
| 49 | I %=2 Q
|
|---|
| 50 | I %=1 D Q
|
|---|
| 51 | . S X=0 F S X=$O(^PRCP(445,"AB",PRCP("I"),X)) Q:'X S ^TMP($J,"PRCPAG","V",X)=$$INVNAME^PRCPUX1(X)
|
|---|
| 52 | S PRCPFLAG=1 Q
|
|---|
