source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRDI0.m@ 619

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1PRCPRDI0 ;WISC/RFJ-update/print due-ins from 410 and 442 ;30 Aug 91
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 N %,PRCPDATD,PRCPDATE,PRCPFLAG,PRCPFUPD,PRCPWHSE,X,Y
6 S PRCPWHSE=$O(^PRC(440,"AC","S",0))_";PRC(440,"
7 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."
8 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
9 ;
10 I $$KEY^PRCPUREP("PRCP"_$TR(PRCP("DPTYPE"),"WSP","W2")_" MGRKEY",DUZ) D
11 . 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"
12 . W ! D ^DIR K DIR I Y<1 S PRCPFLAG=1 Q
13 . I Y'=2 Q
14 . I $P($H,",",2)>21600,$P($H,",",2)<64800 D
15 . . 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."
16 . . D DISPLAY^PRCPUX2(5,75,.X)
17 . S XP="ARE YOU SURE YOU WANT TO UPDATE THE DUE-INS (FROM DATE: "_PRCPDATD_") FOR THIS",XP(1)="INVENTORY POINT"
18 . W ! S %=$$YN^PRCPUYN(2) I '% S PRCPFLAG=1 Q
19 . I %=1 S PRCPFUPD=1
20 I $G(PRCPFLAG) Q
21 ;
22 W ! S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
23 . S ZTDESC="Calculate Due-Ins",ZTRTN="DQ^PRCPRDI1"
24 . S ZTSAVE("PRC*")="",ZTSAVE("ZTREQ")="@"
25 W !!,"<*> please wait <*>"
26 D DQ^PRCPRDI1
27 Q
Note: See TracBrowser for help on using the repository browser.