Routine: PRCPRAIP

PRCPRAIP ;WISC/RFJ/DST-abbreviated item report (primary, second)        ;09 Jun 93

 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37

 ;Per VHA Directive 2004-038, this routine should not be modified.

PRIMARY ;  abbreviated item report for primary and secondary

 N GROUPALL,X

 N ODI,ODIS  ; for On-Demand Item

 K X S X(1)="The Abbreviated Item Report will sort the Primary or Secondary inventory items by the group category code and description." D DISPLAY^PRCPUX2(40,79,.X)

 K X S X(1)="Select the Group Categories to display" D DISPLAY^PRCPUX2(2,40,.X)

 D GROUPSEL^PRCPURS1(PRCP("I"))

 I '$G(GROUPALL),'$O(^TMP($J,"PRCPURS1","YES",0)) W !,"*** NO GROUP CATEGORIES SELECTED !" D Q Q

 W !,"NOTE:  The report will",$S('$G(GROUPALL):" NOT",1:"")," include items not stored in a group category."

 ; Prompt for On-Demand Item selection

 S ODIS=$$ODIPROM^PRCPUX2(0)

 I 'ODIS D Q Q

 W ! S %ZIS="Q" D ^%ZIS Q:POP  I $D(IO("Q")) D  D ^%ZTLOAD K IO("Q"),ZTSK Q

 .   S ZTDESC="Abbreviated Item Report",ZTRTN="DQ^PRCPRAIP"

 .   S ZTSAVE("PRCP*")="",ZTSAVE("GROUPALL")="",ZTSAVE("ODIS")="",ZTSAVE("^TMP($J,""PRCPURS1"",")="",ZTSAVE("ZTREQ")="@"

 W !!,"<*> please wait <*>"

DQ ;  queue starts here

 N %,%H,%I,GROUP,GROUPNM,DESCR,ITEMDA,ITEMDATA,NOW,PAGE,PRCPFLAG,SCREEN,X,Y

 K ^TMP($J,"PRCPRAIP")

 S ITEMDA=0 F  S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA  D

 .   S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))

 .   S GROUP=+$P(ITEMDATA,"^",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=" "

 .   S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA) S:DESCR="" DESCR=" "

 .   S ^TMP($J,"PRCPRAIP",GROUPNM,$E(DESCR,1,15),ITEMDA)=DESCR

 ;  print report

 D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H

 S GROUP="" F  S GROUP=$O(^TMP($J,"PRCPRAIP",GROUP)) Q:GROUP=""!($G(PRCPFLAG))  D

 .   I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG)  D H

 .   W !!?5,"GROUP: ",$S(GROUP=" ":"<<NONE>>",1:GROUP)

 .   S DESCR="" F  S DESCR=$O(^TMP($J,"PRCPRAIP",GROUP,DESCR)) Q:DESCR=""!($G(PRCPFLAG))  S ITEMDA=0 F  S ITEMDA=$O(^TMP($J,"PRCPRAIP",GROUP,DESCR,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG))  S X=^(ITEMDA) D

 .   .   ; Check ODI flag for this item

 .   .   S ODI=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)

 .   .   ; If On-Demand Item display not selected, and is ODI, Quit

 .   .   Q:(ODIS=1)&(ODI="Y")

 .   .   ; If only On-Demand Item display selected, and not ODI, Quit

 .   .   Q:(ODIS=2)&(ODI'="Y")

 .   .   ;

 .   .   I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG)  D H

 .   .   S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))

 .   .   W !,$E(X,1,23),?24,ITEMDA,?31,$S(ODI="Y":"D",1:""),?46,$J(+$P(ITEMDATA,"^",7),8),$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),10),$J($$STORAGE^PRCPESTO(PRCP("I"),ITEMDA),16)

 .   .   S %=0 F  S %=$O(^PRCP(445,PRCP("I"),1,ITEMDA,1,%)) Q:'%!($G(PRCPFLAG))  D

 .   .   .   I $X>60 W !

 .   .   .   S X=$E($$STORELOC^PRCPESTO(%),1,15),X="     "_X_$E("               ",$L(X)+1,15)

 .   .   .   W X

 .   .   .   I $X>60,$Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG)  D H

 .   I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"

 I '$G(PRCPFLAG) D END^PRCPUREP

Q D ^%ZISC K ^TMP($J,"PRCPRAIP"),^TMP($J,"PRCPURS1")

H S %=NOW_"  PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF

 W $C(13),"ABBREVIATED ITEM REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%

 S %="",$P(%,"-",81)=""

 W !,$S(ODIS=2:"ON-DEMAND ITEMS ONLY",ODIS=3:"ALL ITEMS (STANDARD AND ON-DEMAND)",1:"STANDARD ITEMS ONLY")

 W !,"DESCRIPTION",?24,"IM",?31,$S(ODIS>1:"OD",1:""),?41,$J("QTY OH",13),$J("UNIT/IS",10),$J("MAIN STORAGE",16),!?5,"ADD STORAGE",?26,"ADD STORAGE",?46,"ADD STORAGE",?66,"ADD STORAGE",!,%

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRAIP   3951     printed  Apr 23, 2025@18:29:01                                                                                                                                                                                                    Page 2

PRCPRAIP  ;WISC/RFJ/DST-abbreviated item report (primary, second)        ;09 Jun 93

 +1       ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3        QUIT

 +4       ;

 +5       ;

PRIMARY   ;  abbreviated item report for primary and secondary

 +1        NEW GROUPALL,X

 +2       ; for On-Demand Item

           NEW ODI,ODIS

 +3        KILL X

           SET X(1)="The Abbreviated Item Report will sort the Primary or Secondary inventory items by the group category code and description."

           DO DISPLAY^PRCPUX2(40,79,.X)

 +4        KILL X

           SET X(1)="Select the Group Categories to display"

           DO DISPLAY^PRCPUX2(2,40,.X)

 +5        DO GROUPSEL^PRCPURS1(PRCP("I"))

 +6        IF '$GET(GROUPALL)

               IF '$ORDER(^TMP($JOB,"PRCPURS1","YES",0))

                   WRITE !,"*** NO GROUP CATEGORIES SELECTED !"

                   DO Q

                   QUIT

 +7        WRITE !,"NOTE:  The report will",$SELECT('$GET(GROUPALL):" NOT",1:"")," include items not stored in a group category."

 +8       ; Prompt for On-Demand Item selection

 +9        SET ODIS=$$ODIPROM^PRCPUX2(0)

 +10       IF 'ODIS

               DO Q

               QUIT

 +11      ;

 +12       WRITE !

           SET %ZIS="Q"

           DO ^%ZIS

           if POP

               QUIT

           IF $DATA(IO("Q"))

               Begin DoDot:1

 +13               SET ZTDESC="Abbreviated Item Report"

                   SET ZTRTN="DQ^PRCPRAIP"

 +14               SET ZTSAVE("PRCP*")=""

                   SET ZTSAVE("GROUPALL")=""

                   SET ZTSAVE("ODIS")=""

                   SET ZTSAVE("^TMP($J,""PRCPURS1"",")=""

                   SET ZTSAVE("ZTREQ")="@"

               End DoDot:1

               DO ^%ZTLOAD

               KILL IO("Q"),ZTSK

               QUIT

 +15       WRITE !!,"<*> please wait <*>"

DQ        ;  queue starts here

 +1        NEW %,%H,%I,GROUP,GROUPNM,DESCR,ITEMDA,ITEMDATA,NOW,PAGE,PRCPFLAG,SCREEN,X,Y

 +2        KILL ^TMP($JOB,"PRCPRAIP")

 +3        SET ITEMDA=0

FOR

               SET ITEMDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA))

               if 'ITEMDA

                   QUIT

               Begin DoDot:1

 +4                SET ITEMDATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))

 +5                SET GROUP=+$PIECE(ITEMDATA,"^",21)

 +6                IF 'GROUP

                       IF '$GET(GROUPALL)

                           QUIT

 +7                IF $GET(GROUPALL)

                       IF $DATA(^TMP($JOB,"PRCPURS1","NO",GROUP))

                           QUIT

 +8                IF '$GET(GROUPALL)

                       IF '$DATA(^TMP($JOB,"PRCPURS1","YES",GROUP))

                           QUIT

 +9                SET GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)

 +10               IF GROUPNM'=""

                       SET GROUPNM=$EXTRACT(GROUPNM,1,20)_" (#"_GROUP_")"

 +11               if GROUPNM=""

                       SET GROUPNM=" "

 +12               SET DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)

                   if DESCR=""

                       SET DESCR=" "

 +13               SET ^TMP($JOB,"PRCPRAIP",GROUPNM,$EXTRACT(DESCR,1,15),ITEMDA)=DESCR

               End DoDot:1

 +14      ;  print report

 +15       DO NOW^%DTC

           SET Y=%

           DO DD^%DT

           SET NOW=Y

           SET PAGE=1

           SET SCREEN=$$SCRPAUSE^PRCPUREP

           USE IO

           DO H

 +16       SET GROUP=""

FOR

               SET GROUP=$ORDER(^TMP($JOB,"PRCPRAIP",GROUP))

               if GROUP=""!($GET(PRCPFLAG))

                   QUIT

               Begin DoDot:1

 +17               IF $Y>(IOSL-6)

                       if SCREEN

                           DO P^PRCPUREP

                       if $DATA(PRCPFLAG)

                           QUIT

                       DO H

 +18               WRITE !!?5,"GROUP: ",$SELECT(GROUP=" ":"<<NONE>>",1:GROUP)

 +19               SET DESCR=""

FOR

                       SET DESCR=$ORDER(^TMP($JOB,"PRCPRAIP",GROUP,DESCR))

                       if DESCR=""!($GET(PRCPFLAG))

                           QUIT

                       SET ITEMDA=0

FOR

                           SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRAIP",GROUP,DESCR,ITEMDA))

                           if 'ITEMDA!($GET(PRCPFLAG))

                               QUIT

                           SET X=^(ITEMDA)

                           Begin DoDot:2

 +20      ; Check ODI flag for this item

 +21                           SET ODI=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)

 +22      ; If On-Demand Item display not selected, and is ODI, Quit

 +23                           if (ODIS=1)&(ODI="Y")

                                   QUIT

 +24      ; If only On-Demand Item display selected, and not ODI, Quit

 +25                           if (ODIS=2)&(ODI'="Y")

                                   QUIT

 +26      ;

 +27                           IF $Y>(IOSL-6)

                                   if SCREEN

                                       DO P^PRCPUREP

                                   if $DATA(PRCPFLAG)

                                       QUIT

                                   DO H

 +28                           SET ITEMDATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))

 +29                           WRITE !,$EXTRACT(X,1,23),?24,ITEMDA,?31,$SELECT(ODI="Y":"D",1:""),?46,$JUSTIFY(+$PIECE(ITEMDATA,"^",7),8),$JUSTIFY($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),10),$JUSTIFY($$STORAGE^PRCPESTO(PRCP("I"),ITEMDA),16)

 +30                           SET %=0

FOR

                                   SET %=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA,1,%))

                                   if '%!($GET(PRCPFLAG))

                                       QUIT

                                   Begin DoDot:3

 +31                                   IF $X>60

                                           WRITE !

 +32                                   SET X=$EXTRACT($$STORELOC^PRCPESTO(%),1,15)

                                       SET X="     "_X_$EXTRACT("               ",$LENGTH(X)+1,15)

 +33                                   WRITE X

 +34                                   IF $X>60

                                           IF $Y>(IOSL-6)

                                               if SCREEN

                                                   DO P^PRCPUREP

                                               if $DATA(PRCPFLAG)

                                                   QUIT

                                               DO H

                                   End DoDot:3

                           End DoDot:2

 +35               IF $GET(ZTQUEUED)

                       IF $$S^%ZTLOAD

                           SET PRCPFLAG=1

                           WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"

               End DoDot:1

 +36       IF '$GET(PRCPFLAG)

               DO END^PRCPUREP

Q          DO ^%ZISC

           KILL ^TMP($JOB,"PRCPRAIP"),^TMP($JOB,"PRCPURS1")

 +1        QUIT

 +2       ;

H          SET %=NOW_"  PAGE "_PAGE

           SET PAGE=PAGE+1

           IF PAGE'=2!(SCREEN)

               WRITE @IOF

 +1        WRITE $CHAR(13),"ABBREVIATED ITEM REPORT FOR: ",$EXTRACT(PRCP("IN"),1,20),?(80-$LENGTH(%)),%

 +2        SET %=""

           SET $PIECE(%,"-",81)=""

 +3        WRITE !,$SELECT(ODIS=2:"ON-DEMAND ITEMS ONLY",ODIS=3:"ALL ITEMS (STANDARD AND ON-DEMAND)",1:"STANDARD ITEMS ONLY")

 +4        WRITE !,"DESCRIPTION",?24,"IM",?31,$SELECT(ODIS>1:"OD",1:""),?41,$JUSTIFY("QTY OH",13),$JUSTIFY("UNIT/IS",10),$JUSTIFY("MAIN STORAGE",16),!?5,"ADD STORAGE",?26,"ADD STORAGE",?46,"ADD STORAGE",?66,"ADD STORAGE",!,%

 +5        QUIT

PRCPRAIP.m