PRCPRISR.m

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 ---PRCPRISR   1574     printed  Apr 09, 2024@21:06:33                                                                                                                                                                                                    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