PRCPRDI0 ;WISC/RFJ-update/print due-ins from 410 and 442 ;30 Aug 91
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
D ^PRCPUSEL Q:'$G(PRCP("I"))
N %,PRCPDATD,PRCPDATE,PRCPFLAG,PRCPFUPD,PRCPWHSE,X,Y
S PRCPWHSE=$O(^PRC(440,"AC","S",0))_";PRC(440,"
I '$D(^PRC(440,+PRCPWHSE,0)),PRCP("DPTYPE")'="W" W !,"THERE IS NOT A VENDOR IN THE VENDOR FILE (#440) DESIGNATED AS A SUPPLY WHSE.",!,"YOU WILL NOT BE ABLE TO CALCULATE DUE-INS FOR ISSUE BOOK REQUESTS."
W !! S %DT="AEP",%DT("A")="Start with Transactions Requested After DATE: ",%DT(0)=-DT D ^%DT K %DT Q:Y<1 S PRCPDATE=Y D DD^%DT S PRCPDATD=Y
;
I $$KEY^PRCPUREP("PRCP"_$TR(PRCP("DPTYPE"),"WSP","W2")_" MGRKEY",DUZ) D
. S DIR(0)="S^1:Print Report with Calculated Due-Ins;2:Update Due-Ins for Inventory Point",DIR("A")="Select OPTION",DIR("B")="Print Report with Calculated Due-Ins"
. W ! D ^DIR K DIR I Y<1 S PRCPFLAG=1 Q
. I Y'=2 Q
. I $P($H,",",2)>21600,$P($H,",",2)<64800 D
. . K X S X(1)="If you choose to update the due-ins, ALL CONTROL POINT and INVENTORY POINT ACTIVITY will be HALTED for several hours. I STRONGLY suggest you run this report after hours."
. . D DISPLAY^PRCPUX2(5,75,.X)
. S XP="ARE YOU SURE YOU WANT TO UPDATE THE DUE-INS (FROM DATE: "_PRCPDATD_") FOR THIS",XP(1)="INVENTORY POINT"
. W ! S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q
. I %=1 S PRCPFUPD=1
I $G(PRCPFLAG) Q
;
W ! S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. S ZTDESC="Calculate Due-Ins",ZTRTN="DQ^PRCPRDI1"
. S ZTSAVE("PRC*")="",ZTSAVE("ZTREQ")="@"
W !!,"<*> please wait <*>"
D DQ^PRCPRDI1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRDI0 1686 printed Dec 13, 2024@02:14:45 Page 2
PRCPRDI0 ;WISC/RFJ-update/print due-ins from 410 and 442 ;30 Aug 91
+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 NEW %,PRCPDATD,PRCPDATE,PRCPFLAG,PRCPFUPD,PRCPWHSE,X,Y
+5 SET PRCPWHSE=$ORDER(^PRC(440,"AC","S",0))_";PRC(440,"
+6 IF '$DATA(^PRC(440,+PRCPWHSE,0))
IF PRCP("DPTYPE")'="W"
WRITE !,"THERE IS NOT A VENDOR IN THE VENDOR FILE (#440) DESIGNATED AS A SUPPLY WHSE.",!,"YOU WILL NOT BE ABLE TO CALCULATE DUE-INS FOR ISSUE BOOK REQUESTS."
+7 WRITE !!
SET %DT="AEP"
SET %DT("A")="Start with Transactions Requested After DATE: "
SET %DT(0)=-DT
DO ^%DT
KILL %DT
if Y<1
QUIT
SET PRCPDATE=Y
DO DD^%DT
SET PRCPDATD=Y
+8 ;
+9 IF $$KEY^PRCPUREP("PRCP"_$TRANSLATE(PRCP("DPTYPE"),"WSP","W2")_" MGRKEY",DUZ)
Begin DoDot:1
+10 SET DIR(0)="S^1:Print Report with Calculated Due-Ins;2:Update Due-Ins for Inventory Point"
SET DIR("A")="Select OPTION"
SET DIR("B")="Print Report with Calculated Due-Ins"
+11 WRITE !
DO ^DIR
KILL DIR
IF Y<1
SET PRCPFLAG=1
QUIT
+12 IF Y'=2
QUIT
+13 IF $PIECE($HOROLOG,",",2)>21600
IF $PIECE($HOROLOG,",",2)<64800
Begin DoDot:2
+14 KILL X
SET X(1)="If you choose to update the due-ins, ALL CONTROL POINT and INVENTORY POINT ACTIVITY will be HALTED for several hours. I STRONGLY suggest you run this report after hours."
+15 DO DISPLAY^PRCPUX2(5,75,.X)
End DoDot:2
+16 SET XP="ARE YOU SURE YOU WANT TO UPDATE THE DUE-INS (FROM DATE: "_PRCPDATD_") FOR THIS"
SET XP(1)="INVENTORY POINT"
+17 WRITE !
SET %=$$YN^PRCPUYN(2)
IF '%
SET PRCPFLAG=1
QUIT
+18 IF %=1
SET PRCPFUPD=1
End DoDot:1
+19 IF $GET(PRCPFLAG)
QUIT
+20 ;
+21 WRITE !
SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
Begin DoDot:1
+22 SET ZTDESC="Calculate Due-Ins"
SET ZTRTN="DQ^PRCPRDI1"
+23 SET ZTSAVE("PRC*")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+24 WRITE !!,"<*> please wait <*>"
+25 DO DQ^PRCPRDI1
+26 QUIT
