PRCPAGS0 ;WISC/RFJ-autogenerate secondary order ;01 Dec 92
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
D ^PRCPUSEL Q:'$G(PRCP("I"))
I PRCP("DPTYPE")'="S" W !!,"THIS OPTION CAN ONLY BE USED BY SECONDARY INVENTORY POINTS." Q
N %,D,INVPT,PRCPEXIT,PRCPFLAG,PRCPFNON,PRCPFONE,V,X,Y
S %="========== PART 1: SELECTION OF DISTRIBUTION INVENTORY POINTS ==========" W !!?(80-$L(%)\2),%
W !!,"Selected distribution inventory points will be used to auto-generate the order."
K ^TMP($J,"PRCPAG")
S INVPT=$$FROMCHEK^PRCPUDPT(PRCP("I"),0)
I $G(PRCPFNON) W !!,"THIS INVENTORY POINT IS NOT STOCKED BY A PRIMARY INVENTORY POINT." Q
I $G(PRCPFONE) S %=$$INVNAME^PRCPUX1(INVPT) W !!,"This inventory point is only stocked by: ",% S ^TMP($J,"PRCPAG","V",INVPT)=% G AUTOGEN
K PRCPFLAG D ALL Q:$G(PRCPFLAG)
F D Q:$G(PRCPFLAG)
. I $O(^TMP($J,"PRCPAG","V",0)) D
. . W !!!," Currently selected distribution inventory points:",!," "
. . 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 %," "
. . W !," You can DE-select one of the above distribution points by reselecting it."
. W !!,"Select the name of the inventory point that stocks your secondary, '^' to exit."
. I '$O(^TMP($J,"PRCPAG","V",0)) W !,"Press return without a selection to select ALL distribution inventory points."
. S Y=$$FROM^PRCPUDPT(PRCP("I")) I Y["^" S (PRCPEXIT,PRCPFLAG)=1 Q
. I 'Y,'$O(^TMP($J,"PRCPAG","V",0)) D ALL S:$G(PRCPFLAG) PRCPEXIT=1 Q
. I 'Y S PRCPFLAG=1 Q
. I $D(^TMP($J,"PRCPAG","V",+Y)) K ^(+Y) W !?10,"DE-selected !" Q
. S ^TMP($J,"PRCPAG","V",+Y)=$$INVNAME^PRCPUX1(Y) W !?10,"selected !"
I $G(PRCPEXIT) D Q Q
;
AUTOGEN ; start autogen with selected distribution points
S %="========== PART 2: START AUTO-GENERATION ==========" W !!?(80-$L(%)\2),%
I '$O(^TMP($J,"PRCPAG","V",0)) W !!,"NO DISTRIBUTION INVENTORY POINTS SELECTED." Q
W !!,"Auto-generating from the following distribution inventory points:",!
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 %," "
;
; check to see if there are outstanding distribution orders
; unreleased
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
. I '$G(PRCPFLAG) W !!,"The following distribution orders have not been released for filling:"
. 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)
. S PRCPFLAG=1
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."
S XP="ARE YOU SURE YOU WANT TO START AUTO-GENERATION",XH="Enter 'YES' to start auto-generating the order, 'NO' or '^' to exit."
W !! I $$YN^PRCPUYN(%)=1 D START^PRCPAGS1
Q K ^TMP($J,"PRCPAG") Q
;
;
ALL ; select all distribution inventory points
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."
W ! S %=$$YN^PRCPUYN(1)
I %=2 Q
I %=1 D Q
. S X=0 F S X=$O(^PRCP(445,"AB",PRCP("I"),X)) Q:'X S ^TMP($J,"PRCPAG","V",X)=$$INVNAME^PRCPUX1(X)
S PRCPFLAG=1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPAGS0 3504 printed Dec 13, 2024@02:12:41 Page 2
PRCPAGS0 ;WISC/RFJ-autogenerate secondary order ;01 Dec 92
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 DO ^PRCPUSEL
if '$GET(PRCP("I"))
QUIT
+4 IF PRCP("DPTYPE")'="S"
WRITE !!,"THIS OPTION CAN ONLY BE USED BY SECONDARY INVENTORY POINTS."
QUIT
+5 NEW %,D,INVPT,PRCPEXIT,PRCPFLAG,PRCPFNON,PRCPFONE,V,X,Y
+6 SET %="========== PART 1: SELECTION OF DISTRIBUTION INVENTORY POINTS =========="
WRITE !!?(80-$LENGTH(%)\2),%
+7 WRITE !!,"Selected distribution inventory points will be used to auto-generate the order."
+8 KILL ^TMP($JOB,"PRCPAG")
+9 SET INVPT=$$FROMCHEK^PRCPUDPT(PRCP("I"),0)
+10 IF $GET(PRCPFNON)
WRITE !!,"THIS INVENTORY POINT IS NOT STOCKED BY A PRIMARY INVENTORY POINT."
QUIT
+11 IF $GET(PRCPFONE)
SET %=$$INVNAME^PRCPUX1(INVPT)
WRITE !!,"This inventory point is only stocked by: ",%
SET ^TMP($JOB,"PRCPAG","V",INVPT)=%
GOTO AUTOGEN
+12 KILL PRCPFLAG
DO ALL
if $GET(PRCPFLAG)
QUIT
+13 FOR
Begin DoDot:1
+14 IF $ORDER(^TMP($JOB,"PRCPAG","V",0))
Begin DoDot:2
+15 WRITE !!!," Currently selected distribution inventory points:",!," "
+16 SET V=0
FOR
SET V=$ORDER(^TMP($JOB,"PRCPAG","V",V))
if 'V
QUIT
SET %=$EXTRACT(^(V),1,20)
SET %=%_$EXTRACT(" ",$LENGTH(%),20)
if $X>70
WRITE !," "
WRITE %," "
+17 WRITE !," You can DE-select one of the above distribution points by reselecting it."
End DoDot:2
+18 WRITE !!,"Select the name of the inventory point that stocks your secondary, '^' to exit."
+19 IF '$ORDER(^TMP($JOB,"PRCPAG","V",0))
WRITE !,"Press return without a selection to select ALL distribution inventory points."
+20 SET Y=$$FROM^PRCPUDPT(PRCP("I"))
IF Y["^"
SET (PRCPEXIT,PRCPFLAG)=1
QUIT
+21 IF 'Y
IF '$ORDER(^TMP($JOB,"PRCPAG","V",0))
DO ALL
if $GET(PRCPFLAG)
SET PRCPEXIT=1
QUIT
+22 IF 'Y
SET PRCPFLAG=1
QUIT
+23 IF $DATA(^TMP($JOB,"PRCPAG","V",+Y))
KILL ^(+Y)
WRITE !?10,"DE-selected !"
QUIT
+24 SET ^TMP($JOB,"PRCPAG","V",+Y)=$$INVNAME^PRCPUX1(Y)
WRITE !?10,"selected !"
End DoDot:1
if $GET(PRCPFLAG)
QUIT
+25 IF $GET(PRCPEXIT)
DO Q
QUIT
+26 ;
AUTOGEN ; start autogen with selected distribution points
+1 SET %="========== PART 2: START AUTO-GENERATION =========="
WRITE !!?(80-$LENGTH(%)\2),%
+2 IF '$ORDER(^TMP($JOB,"PRCPAG","V",0))
WRITE !!,"NO DISTRIBUTION INVENTORY POINTS SELECTED."
QUIT
+3 WRITE !!,"Auto-generating from the following distribution inventory points:",!
+4 SET V=0
FOR
SET V=$ORDER(^TMP($JOB,"PRCPAG","V",V))
if 'V
QUIT
SET %=$EXTRACT(^(V),1,20)
SET %=%_$EXTRACT(" ",$LENGTH(%),20)
if $X>70
WRITE !
WRITE %," "
+5 ;
+6 ; check to see if there are outstanding distribution orders
+7 ; unreleased
+8 KILL PRCPFLAG
SET X=0
FOR
SET X=$ORDER(^PRCP(445.3,"AD",PRCP("I"),X))
if 'X
QUIT
SET D=$GET(^PRCP(445.3,X,0))
IF D'=""
IF $PIECE(D,"^",6)=""
Begin DoDot:1
+9 IF '$GET(PRCPFLAG)
WRITE !!,"The following distribution orders have not been released for filling:"
+10 WRITE !?5,$PIECE(D,"^"),?15,"primary ",$$INVNAME^PRCPUX1(+$PIECE(D,"^",2)),?50,"Date: ",$EXTRACT($PIECE(D,"^",4),4,5),"-",$EXTRACT($PIECE(D,"^",4),6,7),"-",$EXTRACT($PIECE(D,"^",4),2,3)
+11 SET PRCPFLAG=1
End DoDot:1
+12 SET %=1
IF $GET(PRCPFLAG)
SET %=2
WRITE !,"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."
+13 SET XP="ARE YOU SURE YOU WANT TO START AUTO-GENERATION"
SET XH="Enter 'YES' to start auto-generating the order, 'NO' or '^' to exit."
+14 WRITE !!
IF $$YN^PRCPUYN(%)=1
DO START^PRCPAGS1
Q KILL ^TMP($JOB,"PRCPAG")
QUIT
+1 ;
+2 ;
ALL ; select all distribution inventory points
+1 SET XP=" Do you want to select ALL distribution inventory points"
SET XH=" Enter 'YES' to autogen from ALL distribution inventory points,"
SET XH(1)=" 'NO' or '^' to exit."
+2 WRITE !
SET %=$$YN^PRCPUYN(1)
+3 IF %=2
QUIT
+4 IF %=1
Begin DoDot:1
+5 SET X=0
FOR
SET X=$ORDER(^PRCP(445,"AB",PRCP("I"),X))
if 'X
QUIT
SET ^TMP($JOB,"PRCPAG","V",X)=$$INVNAME^PRCPUX1(X)
End DoDot:1
QUIT
+6 SET PRCPFLAG=1
QUIT
