source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRUSE.m@ 810

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

initial load of WorldVistAEHR
File size: 4.5 KB
RevLine 
[613]1PRCPRUSE ;WISC/RFJ,DWA,VAC-usage demand item report ; 10/19/06 9:53am
2V ;;5.1;IFCAP;**1,27,84,98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 D ^PRCPUSEL Q:'$G(PRCP("I"))
5 ;
6 N DATEEND,DATEENDD,DATESTRD,DATESTRT,DIR,GROUPALL,PRCPALLI,PRCPEND,PRCPSTRT,TOTALDAY,X,X1,X2,Y
7 N ODIFLG,ODITEM,REORDER,PRCPSORT
8 ;
9 K X S X(1)="The Usage Demand Item Report will show the quantity of items used within a specified date period."
10 D DISPLAY^PRCPUX2(40,79,.X)
11 ;
12 K X S X(1)="Select the date range which should be used for displaying the usage. *** Select by month & year only. ***"
13 D DISPLAY^PRCPUX2(2,40,.X)
14 D MONTHSEL^PRCPURS2
15 I '$G(DATEEND) Q
16 ;
17 S X1=DATEEND,X2=DATESTRT D ^%DTC S TOTALDAY=X+1
18 S Y=DATEEND D DD^%DT
19 S DATEENDD=Y,Y=DATESTRT D DD^%DT
20 S DATESTRD=Y
21 W !?5,"-- TOTAL NUMBER OF DAYS: ",TOTALDAY
22 ;
23 ; item(s)
24 K X S X(1)="Select specific items to display."
25 D DISPLAY^PRCPUX2(2,40,.X)
26 D ITEMSEL^PRCPURS4
27 I '$G(PRCPALLI),'$O(^TMP($J,"PRCPURS4","")) Q
28 I '$G(PRCPALLI) D G SORT
29 . S GROUPALL=1
30 ;
31 ; whse sort
32 I PRCP("DPTYPE")="W" D I '$D(PRCPSTRT) Q
33 . K X S X(1)="Select the range of NSNs to display" D DISPLAY^PRCPUX2(2,40,.X)
34 . D NSNSEL^PRCPURS0
35 ;
36 ; prim/seco sort
37 I PRCP("DPTYPE")'="W" D I '$G(GROUPALL),'$O(^TMP($J,"PRCPURS1","YES",0)) W !,"*** NO GROUP CATEGORIES SELECTED !" Q
38 . K X S X(1)="Select the Group Categories to display" D DISPLAY^PRCPUX2(2,40,.X)
39 . D GROUPSEL^PRCPURS1(PRCP("I"))
40 ;
41SORT S ODIFLG=3
42 I PRCP("DPTYPE")'="W" D
43 .Q:$G(PRCPALLI)=""
44 .S ODIFLG=$$ODIPROM^PRCPUX2(0)
45 Q:ODIFLG=0
46 S PRCPSORT=$$SRTPRMP^PRCPUX2(0)
47 Q:PRCPSORT=0
48 ;
49QUEUE S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D Q
50 . S ZTDESC="Usage Demand Item Report",ZTRTN="DQ^PRCPRUSE"
51 . S ZTSAVE("^TMP($J,""PRCPURS4"",")="",ZTSAVE("^TMP($J,""PRCPURS1"",")="",ZTSAVE(ODIFLG)=""
52 . S ZTSAVE("DATE*")="",ZTSAVE("GROUP*")="",ZTSAVE("PRCP*")="",ZTSAVE("TOTALDAY")="",ZTSAVE("ZTREQ")="@"
53 . S ZTSAVE("O*")=""
54 . D ^%ZTLOAD
55 W !!,"<*> please wait <*>"
56 ;
57DQ ; queue starts here
58 N %,%H,%I,COLUMN,DATA,DATE,DESCR,GROUP,GROUPNM,ITEMDA,MONYR,NOW,NSN,PAGE,PRCPFLAG,SCREEN,TOTCOST,TOTUSED,TTOTCOST,TTOTUSED,VALUE,X,Y
59 K ^TMP($J,"PRCPRUSE")
60 S ITEMDA=0
61 I $G(PRCPALLI) F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA S DATA=$G(^(ITEMDA,0)) I DATA'="" D
62 . S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)
63 . S VALUE=DESCR_"^"_$$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/")_"^"_$P(DATA,"^",15)_"^"_$P(DATA,"^",22)_"^"_($P(DATA,"^",7)+$P(DATA,"^",19))
64 . ;
65 . ; sort for whse
66 . I PRCP("DPTYPE")="W" D Q
67 . . S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
68 . . I $E(NSN,1,$L(PRCPSTRT))'=PRCPSTRT,$E(NSN,1,$L(PRCPEND))'=PRCPEND I NSN']PRCPSTRT!(PRCPEND']NSN) Q
69 . . I PRCPSORT=1 S ^TMP($J,"PRCPRUSE",NSN,$E(DESCR,1,15),ITEMDA)=VALUE
70 . . I PRCPSORT=2 S ^TMP($J,"PRCPRUSE",NSN,$E("000000000",$L(ITEMDA)+1,9)_ITEMDA,ITEMDA)=VALUE
71 . ;
72 . ; sort for primary and secondary
73 . S GROUP=+$P(DATA,"^",21)
74 . I 'GROUP,'$G(GROUPALL) Q
75 . I $G(GROUPALL),$D(^TMP($J,"PRCPURS1","NO",GROUP)) Q
76 . I '$G(GROUPALL),'$D(^TMP($J,"PRCPURS1","YES",GROUP)) Q
77 . S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
78 . I GROUPNM'="" S GROUPNM=$E(GROUPNM,1,20)_" (#"_GROUP_")"
79 . S:GROUPNM="" GROUPNM=" "
80 . I PRCPSORT=1 S ^TMP($J,"PRCPRUSE",GROUPNM,$E(DESCR,1,15),ITEMDA)=VALUE
81 . I PRCPSORT=2 S ^TMP($J,"PRCPRUSE",GROUPNM,$E("000000000",$L(ITEMDA)+1,9)_ITEMDA,ITEMDA)=VALUE
82 ;
83 I '$G(PRCPALLI) F S ITEMDA=$O(^TMP($J,"PRCPURS4",ITEMDA)) Q:'ITEMDA S DATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0)) I DATA'="" D
84 . S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)
85 . S VALUE=DESCR_"^"_$$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/")_"^"_$P(DATA,"^",15)_"^"_$P(DATA,"^",22)_"^"_($P(DATA,"^",7)+$P(DATA,"^",19))
86 . ;
87 . ; sort for whse
88 . I PRCP("DPTYPE")="W" D Q
89 . . S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
90 . . I PRCPSORT=1 S ^TMP($J,"PRCPRUSE",NSN,$E(DESCR,1,15),ITEMDA)=VALUE
91 . . I PRCPSORT=2 S ^TMP($J,"PRCPRUSE",NSN,$E("000000000",$L(ITEMDA)+1,9)_ITEMDA,ITEMDA)=VALUE
92 . ;
93 . ; sort for primary and secondary
94 . S GROUP=+$P(DATA,"^",21)
95 . I 'GROUP,'$G(GROUPALL) Q
96 . I $G(GROUPALL),$D(^TMP($J,"PRCPURS1","NO",GROUP)) Q
97 . I '$G(GROUPALL),'$D(^TMP($J,"PRCPURS1","YES",GROUP)) Q
98 . S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
99 . I GROUPNM'="" S GROUPNM=$E(GROUPNM,1,20)_" (#"_GROUP_")"
100 . S:GROUPNM="" GROUPNM=" "
101 . I PRCPSORT=1 S ^TMP($J,"PRCPRUSE",GROUPNM,$E(DESCR,1,15),ITEMDA)=VALUE
102 . I PRCPSORT=2 S ^TMP($J,"PRCPRUSE",GROUPNM,$E("000000000",$L(ITEMDA)+1,9)_ITEMDA,ITEMDA)=VALUE
103 ;
104 D PRINT^PRCPRUSP
105 Q
Note: See TracBrowser for help on using the repository browser.