source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRAVP.m@ 1424

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1PRCPRAVP ;WISC/RFJ-availability list report (primary) ;18 May 93
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7PRIMARY ; availability list for primary (called from prcpravl)
8 N GROUPALL,PRCPSUMM
9 K X S X(1)="The Availability Listing will display the current quantity and value of the inventory point items. The report will sort Primary or Secondary inventory items by Group Category and Description." D DISPLAY^PRCPUX2(40,79,.X)
10 S PRCPSUMM=$$SUMMARY^PRCPURS0 I PRCPSUMM<0 Q
11 I PRCPSUMM S GROUPALL=1 G DEVICE
12 K X S X(1)="Select the Group Categories to display" W ! D DISPLAY^PRCPUX2(2,40,.X)
13 D GROUPSEL^PRCPURS1(PRCP("I"))
14 I '$G(GROUPALL),'$O(^TMP($J,"PRCPURS1","YES",0)) W !,"*** NO GROUP CATEGORIES SELECTED !" D Q Q
15 W !,"NOTE: The report will",$S('$G(GROUPALL):" NOT",1:"")," include items not stored in a group category."
16DEVICE W ! S %ZIS="Q" D ^%ZIS G:POP Q I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D Q Q
17 . S ZTDESC="Primary Availability Listing",ZTRTN="DQ^PRCPRAVP"
18 . S ZTSAVE("PRCP*")="",ZTSAVE("GROUPALL")="",ZTSAVE("^TMP($J,""PRCPURS1"",")="",ZTSAVE("ZTREQ")="@"
19 W !!,"<*> please wait <*>"
20DQ ; queue starts here
21 N %I,DESCR,DESCRIP,GROUP,GROUPNM,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,TOTAL,TOTINV,X,Y
22 K ^TMP($J,"PRCPRAVP"),^TMP($J,"PRCPRAVP TOT")
23 S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA S ITEMDATA=$G(^(ITEMDA,0)) D
24 . S GROUP=+$P(ITEMDATA,"^",21)
25 . I 'GROUP,'$G(GROUPALL) Q
26 . I $G(GROUPALL),$D(^TMP($J,"PRCPURS1","NO",GROUP)) Q
27 . I '$G(GROUPALL),'$D(^TMP($J,"PRCPURS1","YES",GROUP)) Q
28 . S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
29 . I GROUPNM'="" S GROUPNM=$E(GROUPNM,1,20)_" (#"_GROUP_")"
30 . S:GROUPNM="" GROUPNM=" "
31 . S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA) S:DESCR="" DESCR=" "
32 . S ^TMP($J,"PRCPRAVP",GROUPNM,$E(DESCR,1,15),ITEMDA)=DESCR
33 ; print report
34 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
35 S GROUPNM="" F S GROUPNM=$O(^TMP($J,"PRCPRAVP",GROUPNM)) Q:GROUPNM=""!($G(PRCPFLAG)) D
36 . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
37 . W:'PRCPSUMM !!?5,"GROUP NAME: ",$S(GROUPNM=" ":"<<ITEMS NOT STORED IN A GROUP CATEGORY>>",1:GROUPNM)
38 . S DESCR="" F S DESCR=$O(^TMP($J,"PRCPRAVP",GROUPNM,DESCR)) Q:DESCR=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRAVP",GROUPNM,DESCR,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) D
39 . . S DESCRIP=^TMP($J,"PRCPRAVP",GROUPNM,DESCR,ITEMDA)
40 . . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
41 . . S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN="<<NO NSN>>"
42 . . W:'PRCPSUMM !!,$TR(NSN,"-"),?15,$E(DESCRIP,1,38),?54,"[",ITEMDA,"]",?63,$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8),?79,$S($P(ITEMDATA,"^",26)="Y":"*",1:"")
43 . . W:'PRCPSUMM !,$J("ONHAND",16),$J("DUEIN",8),$J("DUEOUT",8),$J("REORDPT",8),$J("ISSMUL",8),$J("AVGCOST",10),$J("TOTVALUE",22)
44 . . W:'PRCPSUMM !,$J(+$P(ITEMDATA,"^",7),16),$J($$GETIN^PRCPUDUE(PRCP("I"),ITEMDA),8),$J($$GETOUT^PRCPUDUE(PRCP("I"),ITEMDA),8),$J(+$P(ITEMDATA,"^",10),8)
45 . . W:'PRCPSUMM $J($P(ITEMDATA,"^",25),8),$J($P(ITEMDATA,"^",22),10,3)
46 . . I +$J($P(ITEMDATA,"^",7)*$P(ITEMDATA,"^",22),0,2)'=+$P(ITEMDATA,"^",27) W:'PRCPSUMM " <=/=>"
47 . . W:'PRCPSUMM ?64,$J($P(ITEMDATA,"^",27),15,2)
48 . . S ^TMP($J,"PRCPRAVP TOT",GROUPNM)=$G(^TMP($J,"PRCPRAVP TOT",GROUPNM))+$P(ITEMDATA,"^",27)
49 . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
50 . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
51 I $G(PRCPFLAG) D Q Q
52 I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
53 W !!?2,"TOTALS :",?40,"INVENTORY VALUE",!?2,"--------",?40,"---------------"
54 S TOTINV=0,GROUPNM="" F S GROUPNM=$O(^TMP($J,"PRCPRAVP TOT",GROUPNM)) Q:GROUPNM=""!($G(PRCPFLAG)) S TOTAL=^(GROUPNM) D
55 . W !?2,"GROUP ",$S(GROUPNM=" ":"<<NONE>>",1:GROUPNM),?40,":",$J(TOTAL,14,2)
56 . S TOTINV=TOTINV+TOTAL
57 . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
58 W !?2,"--------",?40,"---------------"
59 W !?2,"TOTALS :",?40,$J(TOTINV,15,2)
60 D END^PRCPUREP
61Q D ^%ZISC K ^TMP($J,"PRCPRAVP"),^TMP($J,"PRCPRAVP TOT"),^TMP($J,"PRCPRURS1")
62 Q
63 ;
64H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
65 W $C(13),"AVAILABILITY LISTING FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
66 S %="",$P(%,"-",81)=""
67 I PRCPSUMM W !?1,"*** ONLY SUMMARY OF ITEMS PRINTED ***",!,% Q
68 W !,"DESCR",?15,"DESCRIPTION",?40,"MI",$J("UNIT/IS",14),?77,"KWZ",!,%
69 Q
Note: See TracBrowser for help on using the repository browser.