PRCPRUSE ;WISC/RFJ,DWA,VAC-usage demand item report  ; 10/19/06 9:53am
V ;;5.1;IFCAP;**1,27,84,98**;Oct 20, 2000;Build 37
 ;Per VHA Directive 2004-038, this routine should not be modified.
 D ^PRCPUSEL Q:'$G(PRCP("I"))
 ;
 N DATEEND,DATEENDD,DATESTRD,DATESTRT,DIR,GROUPALL,PRCPALLI,PRCPEND,PRCPSTRT,TOTALDAY,X,X1,X2,Y
 N ODIFLG,ODITEM,REORDER,PRCPSORT
 ;
 K X S X(1)="The Usage Demand Item Report will show the quantity of items used within a specified date period."
 D DISPLAY^PRCPUX2(40,79,.X)
 ;
 K X S X(1)="Select the date range which should be used for displaying the usage.        *** Select by month & year only. ***"
 D DISPLAY^PRCPUX2(2,40,.X)
 D MONTHSEL^PRCPURS2
 I '$G(DATEEND) Q
 ;
 S X1=DATEEND,X2=DATESTRT D ^%DTC S TOTALDAY=X+1
 S Y=DATEEND D DD^%DT
 S DATEENDD=Y,Y=DATESTRT D DD^%DT
 S DATESTRD=Y
 W !?5,"-- TOTAL NUMBER OF DAYS: ",TOTALDAY
 ;
 ;  item(s)
 K X S X(1)="Select specific items to display."
 D DISPLAY^PRCPUX2(2,40,.X)
 D ITEMSEL^PRCPURS4
 I '$G(PRCPALLI),'$O(^TMP($J,"PRCPURS4","")) Q
 I '$G(PRCPALLI) D  G SORT
 .   S GROUPALL=1
 ;
 ;  whse sort
 I PRCP("DPTYPE")="W" D  I '$D(PRCPSTRT) Q
 .   K X S X(1)="Select the range of NSNs to display" D DISPLAY^PRCPUX2(2,40,.X)
 .   D NSNSEL^PRCPURS0
 ;
 ;  prim/seco sort
 I PRCP("DPTYPE")'="W" D  I '$G(GROUPALL),'$O(^TMP($J,"PRCPURS1","YES",0)) W !,"*** NO GROUP CATEGORIES SELECTED !" Q
 .   K X S X(1)="Select the Group Categories to display" D DISPLAY^PRCPUX2(2,40,.X)
 .   D GROUPSEL^PRCPURS1(PRCP("I"))
 ;
SORT S ODIFLG=3
 I PRCP("DPTYPE")'="W" D
 .Q:$G(PRCPALLI)=""
 .S ODIFLG=$$ODIPROM^PRCPUX2(0)
 Q:ODIFLG=0
 S PRCPSORT=$$SRTPRMP^PRCPUX2(0)
 Q:PRCPSORT=0
 ;
QUEUE S %ZIS="Q" D ^%ZIS Q:POP  I $D(IO("Q")) D  Q
 .   S ZTDESC="Usage Demand Item Report",ZTRTN="DQ^PRCPRUSE"
 .   S ZTSAVE("^TMP($J,""PRCPURS4"",")="",ZTSAVE("^TMP($J,""PRCPURS1"",")="",ZTSAVE(ODIFLG)=""
 .   S ZTSAVE("DATE*")="",ZTSAVE("GROUP*")="",ZTSAVE("PRCP*")="",ZTSAVE("TOTALDAY")="",ZTSAVE("ZTREQ")="@"
 .   S ZTSAVE("O*")=""
 .   D ^%ZTLOAD
 W !!,"<*> please wait <*>"
 ;
DQ ;  queue starts here
 N %,%H,%I,COLUMN,DATA,DATE,DESCR,GROUP,GROUPNM,ITEMDA,MONYR,NOW,NSN,PAGE,PRCPFLAG,SCREEN,TOTCOST,TOTUSED,TTOTCOST,TTOTUSED,VALUE,X,Y
 K ^TMP($J,"PRCPRUSE")
 S ITEMDA=0
 I $G(PRCPALLI) F  S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA  S DATA=$G(^(ITEMDA,0)) I DATA'="" D
 .   S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)
 .   S VALUE=DESCR_"^"_$$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/")_"^"_$P(DATA,"^",15)_"^"_$P(DATA,"^",22)_"^"_($P(DATA,"^",7)+$P(DATA,"^",19))
 .   ;
 .   ;  sort for whse
 .   I PRCP("DPTYPE")="W" D  Q
 .   .   S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
 .   .   I $E(NSN,1,$L(PRCPSTRT))'=PRCPSTRT,$E(NSN,1,$L(PRCPEND))'=PRCPEND I NSN']PRCPSTRT!(PRCPEND']NSN) Q
 .   .   I PRCPSORT=1 S ^TMP($J,"PRCPRUSE",NSN,$E(DESCR,1,15),ITEMDA)=VALUE
 .   .   I PRCPSORT=2 S ^TMP($J,"PRCPRUSE",NSN,$E("000000000",$L(ITEMDA)+1,9)_ITEMDA,ITEMDA)=VALUE
 .   ;
 .   ;  sort for primary and secondary
 .   S GROUP=+$P(DATA,"^",21)
 .   I 'GROUP,'$G(GROUPALL) Q
 .   I $G(GROUPALL),$D(^TMP($J,"PRCPURS1","NO",GROUP)) Q
 .   I '$G(GROUPALL),'$D(^TMP($J,"PRCPURS1","YES",GROUP)) Q
 .   S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
 .   I GROUPNM'="" S GROUPNM=$E(GROUPNM,1,20)_" (#"_GROUP_")"
 .   S:GROUPNM="" GROUPNM=" "
 .   I PRCPSORT=1 S ^TMP($J,"PRCPRUSE",GROUPNM,$E(DESCR,1,15),ITEMDA)=VALUE
 .   I PRCPSORT=2 S ^TMP($J,"PRCPRUSE",GROUPNM,$E("000000000",$L(ITEMDA)+1,9)_ITEMDA,ITEMDA)=VALUE
 ;
 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
 .   S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)
 .   S VALUE=DESCR_"^"_$$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/")_"^"_$P(DATA,"^",15)_"^"_$P(DATA,"^",22)_"^"_($P(DATA,"^",7)+$P(DATA,"^",19))
 .   ;
 .   ;  sort for whse
 .   I PRCP("DPTYPE")="W" D  Q
 .   .   S NSN=$$NSN^PRCPUX1(ITEMDA) S:NSN="" NSN=" "
 .   .   I PRCPSORT=1 S ^TMP($J,"PRCPRUSE",NSN,$E(DESCR,1,15),ITEMDA)=VALUE
 .   .   I PRCPSORT=2 S ^TMP($J,"PRCPRUSE",NSN,$E("000000000",$L(ITEMDA)+1,9)_ITEMDA,ITEMDA)=VALUE
 .   ;
 .   ;  sort for primary and secondary
 .   S GROUP=+$P(DATA,"^",21)
 .   I 'GROUP,'$G(GROUPALL) Q
 .   I $G(GROUPALL),$D(^TMP($J,"PRCPURS1","NO",GROUP)) Q
 .   I '$G(GROUPALL),'$D(^TMP($J,"PRCPURS1","YES",GROUP)) Q
 .   S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
 .   I GROUPNM'="" S GROUPNM=$E(GROUPNM,1,20)_" (#"_GROUP_")"
 .   S:GROUPNM="" GROUPNM=" "
 .   I PRCPSORT=1 S ^TMP($J,"PRCPRUSE",GROUPNM,$E(DESCR,1,15),ITEMDA)=VALUE
 .   I PRCPSORT=2 S ^TMP($J,"PRCPRUSE",GROUPNM,$E("000000000",$L(ITEMDA)+1,9)_ITEMDA,ITEMDA)=VALUE
 ;
 D PRINT^PRCPRUSP
 Q