Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPRUSE

PRCPRUSE.m

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