source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRIIR.m@ 1464

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

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1PRCPRIIR ;WISC/RFJ-inactive item report (option, whse) ;10 Aug 93
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCPUSEL Q:'$D(PRCP("I"))
5 I PRCP("DPTYPE")'="W" D PRIMARY^PRCPRIIP Q
6 ;
7 N DATEINAC,PRCPEND,PRCPSTRT,X,Y
8 K X S X(1)="The Inactive Items Report will print items which have no receipts or issues after a specified cutoff date. The report is sorted by NSN."
9 D DISPLAY^PRCPUX2(40,79,.X)
10 K X S X(1)="Select the range of NSNs to display" D DISPLAY^PRCPUX2(2,40,.X)
11 D NSNSEL^PRCPURS0 I '$D(PRCPSTRT) Q
12 K X S X(1)="Enter the Inactivity cutoff date." D DISPLAY^PRCPUX2(2,40,.X)
13 S X1=DT,X2=-90 D C^%DTC S Y=$E(X,1,5)_"00" D DD^%DT
14 S %DT(0)=-($E(DT,1,5)_"00"),%DT="AEP",%DT("B")=Y,%DT("A")="Enter Inactivity Cutoff MONTH and YEAR: " D ^%DT K %DT I Y<1 Q
15 S DATEINAC=$E(Y,1,5)_"00"
16 W ! S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
17 . S ZTDESC="Inactive Item Report",ZTRTN="DQ^PRCPRIIR"
18 . S ZTSAVE("PRCP*")="",ZTSAVE("DATEINAC")="",ZTSAVE("ZTREQ")="@"
19 W !!,"<*> please wait <*>"
20DQ ; queue starts here
21 N %,%I,D,DATEFROM,DUEOUT,ITEMDA,NOW,NSN,PAGE,PRCPFLAG,QTY,RECPT,SCREEN,TOTAL,TOTDAYS,USAGE,X,Y
22 K ^TMP($J,"PRCPRIIR")
23 S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA S D=$G(^(ITEMDA,0)) I D'="" D
24 . ; if reusable quit
25 . I $$REUSABLE^PRCPU441(ITEMDA) Q
26 . S QTY=$P(D,"^",7)+$P(D,"^",19) I 'QTY Q
27 . S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
28 . I $E(NSN,1,$L(PRCPSTRT))'=PRCPSTRT,$E(NSN,1,$L(PRCPEND))'=PRCPEND I NSN']PRCPSTRT!(PRCPEND']NSN) Q
29 . I $O(^PRCP(445,PRCP("I"),1,ITEMDA,2,$E(DATEINAC,1,5)-.01))!($O(^PRCP(445,PRCP("I"),1,ITEMDA,3,DATEINAC))) Q
30 . ; find last usage date
31 . S (USAGE,X)=0 F S X=$O(^PRCP(445,PRCP("I"),1,ITEMDA,2,X)) Q:'X S USAGE=X
32 . S USAGE=$S('USAGE:"",1:$E(USAGE,4,5)_"/"_$E(USAGE,2,3))
33 . ; find last receipt date
34 . S (RECPT,X)=0 F S X=$O(^PRCP(445,PRCP("I"),1,ITEMDA,3,X)) Q:'X S RECPT=X
35 . S RECPT=$S('RECPT:"",1:$E(RECPT,4,5)_"/"_$E(RECPT,6,7)_"/"_$E(RECPT,2,3))
36 . S DUEOUT=$$GETOUT^PRCPUDUE(PRCP("I"),ITEMDA) I 'DUEOUT S DUEOUT=""
37 . S ^TMP($J,"PRCPRIIR",NSN,ITEMDA)=USAGE_"^"_RECPT_"^"_DUEOUT_"^"_QTY_"^"_$P(D,"^",27)_"^"_$S($P(D,"^",26)="Y":"*",1:"")
38 ; print report
39 S X1=DT,X2=DATEINAC D ^%DTC S TOTDAYS=X
40 S Y=DATEINAC D DD^%DT S DATEFROM=Y
41 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
42 S TOTAL=0,NSN="" F S NSN=$O(^TMP($J,"PRCPRIIR",NSN)) Q:NSN=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRIIR",NSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S D=^(ITEMDA) D
43 . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
44 . W !,$TR(NSN,"-"),?15,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,20),?36,ITEMDA
45 . W ?42,$J($P(D,"^"),5),$J($P(D,"^",2),10),$J($P(D,"^",3),6),$J($P(D,"^",4),7),$J($P(D,"^",5),8,2),$J($P(D,"^",6),2)
46 . S TOTAL=TOTAL+$P(D,"^",5)
47 . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
48 I '$G(PRCPFLAG),$Y>(IOSL-3) D:SCREEN P^PRCPUREP I '$G(PRCPFLAG) D H
49 I $G(PRCPFLAG) D Q Q
50 W !!?30,"TOTAL INACTIVE ITEM VALUE IN STOCK: ",$J(TOTAL,12,2)
51 D END^PRCPUREP
52Q D ^%ZISC K ^TMP($J,"PRCPRIIR")
53 Q
54 ;
55 ;
56H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
57 W $C(13),"INACTIVE ITEM REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
58 S %="",$P(%,"-",81)=""
59 W !?5,"INACTIVE ITEMS RANGE FROM ",DATEFROM," TO ",$P(NOW,"@")," (",TOTDAYS," DAYS)",?79,"K"
60 W !?42,$J("LAST",5),$J("LAST",10),$J("DUE",6),$J("QTY",7),$J("TOTAL",8),$J("W",2),!,"NSN",?15,"DESCRIPTION",?36,"MI",?42,$J("USAGE",5),$J("RECEIPT",10),$J("OUT",6),$J("ONHND",7),$J("VALUE",8),$J("Z",2),!,%
61 Q
Note: See TracBrowser for help on using the repository browser.