- PRCPRISR ;WISC/RFJ-inventory sales (option, whse) ;24 May 93
- V ;;5.1;IFCAP;**1**;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- D ^PRCPUSEL Q:'$G(PRCP("I"))
- I PRCP("DPTYPE")="P" D PRIMARY^PRCPRISP Q
- I PRCP("DPTYPE")="S" D SECOND^PRCPRISS Q
- ;
- ; inventory sales report for whse
- N DATEEND,DATESTRT,DISTRALL,PRCPEND,PRCPSTRT,PRCPSUMM,X
- K X S X(1)="The Inventory Sales Report will display all sales from the Warehouse to the Primary inventory points. This report is sorted by NSN, the distribution point, and date issued." D DISPLAY^PRCPUX2(40,79,.X)
- K X S X(1)="Select the range of NSNs to display" W !! D DISPLAY^PRCPUX2(2,40,.X)
- D NSNSEL^PRCPURS0 I '$D(PRCPSTRT) Q
- K X S X(1)="Select the DISTRIBUTION POINTS to display" D DISPLAY^PRCPUX2(2,40,.X)
- D DISTRSEL^PRCPURS3(PRCP("I"))
- I '$G(DISTRALL),'$O(^TMP($J,"PRCPURS3","YES",0)) W !,"*** NO DISTRIBUTION POINTS SELECTED !" D Q Q
- K X S X(1)="Select the range of ISSUE DATES to display" W !! D DISPLAY^PRCPUX2(2,40,.X)
- D DATESEL^PRCPURS2("Issue") I '$G(DATEEND) D Q Q
- S PRCPSUMM=$$SUMMARY^PRCPURS0 I PRCPSUMM<0 D Q Q
- W ! S %ZIS="Q" D ^%ZIS G:POP Q I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D Q Q
- . S ZTDESC="Warehouse Inventory Sales Report",ZTRTN="DQ^PRCPRISR"
- . S ZTSAVE("PRCP*")="",ZTSAVE("DATE*")="",ZTSAVE("DISTRALL")="",ZTSAVE("^TMP($J,""PRCPURS3"",")="",ZTSAVE("ZTREQ")="@"
- W !!,"<*> please wait <*>"
- DQ ; queue starts here
- D PRINT^PRCPRISW
- Q D ^%ZISC K ^TMP($J,"PRCPURS3"),^TMP($J,"PRCPRISR"),^TMP($J,"PRCPRISR TOT")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRISR 1574 printed Apr 23, 2025@18:29:32 Page 2
- PRCPRISR ;WISC/RFJ-inventory sales (option, whse) ;24 May 93
- V ;;5.1;IFCAP;**1**;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 DO ^PRCPUSEL
- if '$GET(PRCP("I"))
- QUIT
- +3 IF PRCP("DPTYPE")="P"
- DO PRIMARY^PRCPRISP
- QUIT
- +4 IF PRCP("DPTYPE")="S"
- DO SECOND^PRCPRISS
- QUIT
- +5 ;
- +6 ; inventory sales report for whse
- +7 NEW DATEEND,DATESTRT,DISTRALL,PRCPEND,PRCPSTRT,PRCPSUMM,X
- +8 KILL X
- SET X(1)="The Inventory Sales Report will display all sales from the Warehouse to the Primary inventory points. This report is sorted by NSN, the distribution point, and date issued."
- DO DISPLAY^PRCPUX2(40,79,.X)
- +9 KILL X
- SET X(1)="Select the range of NSNs to display"
- WRITE !!
- DO DISPLAY^PRCPUX2(2,40,.X)
- +10 DO NSNSEL^PRCPURS0
- IF '$DATA(PRCPSTRT)
- QUIT
- +11 KILL X
- SET X(1)="Select the DISTRIBUTION POINTS to display"
- DO DISPLAY^PRCPUX2(2,40,.X)
- +12 DO DISTRSEL^PRCPURS3(PRCP("I"))
- +13 IF '$GET(DISTRALL)
- IF '$ORDER(^TMP($JOB,"PRCPURS3","YES",0))
- WRITE !,"*** NO DISTRIBUTION POINTS SELECTED !"
- DO Q
- QUIT
- +14 KILL X
- SET X(1)="Select the range of ISSUE DATES to display"
- WRITE !!
- DO DISPLAY^PRCPUX2(2,40,.X)
- +15 DO DATESEL^PRCPURS2("Issue")
- IF '$GET(DATEEND)
- DO Q
- QUIT
- +16 SET PRCPSUMM=$$SUMMARY^PRCPURS0
- IF PRCPSUMM<0
- DO Q
- QUIT
- +17 WRITE !
- SET %ZIS="Q"
- DO ^%ZIS
- if POP
- GOTO Q
- IF $DATA(IO("Q"))
- Begin DoDot:1
- +18 SET ZTDESC="Warehouse Inventory Sales Report"
- SET ZTRTN="DQ^PRCPRISR"
- +19 SET ZTSAVE("PRCP*")=""
- SET ZTSAVE("DATE*")=""
- SET ZTSAVE("DISTRALL")=""
- SET ZTSAVE("^TMP($J,""PRCPURS3"",")=""
- SET ZTSAVE("ZTREQ")="@"
- End DoDot:1
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- DO Q
- QUIT
- +20 WRITE !!,"<*> please wait <*>"
- DQ ; queue starts here
- +1 DO PRINT^PRCPRISW
- Q DO ^%ZISC
- KILL ^TMP($JOB,"PRCPURS3"),^TMP($JOB,"PRCPRISR"),^TMP($JOB,"PRCPRISR TOT")
- +1 QUIT
