PRCPCDIR.m

PRCPCDIR ;WISC/RFJ-disassemble cc or ik (print items)               ;01 Sep 93

 ;;5.1;IFCAP;;Oct 20, 2000

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 Q

 ;

 ;

PRINT(ITEMDA,QUANTITY) ;  print items to disassemble

 ;  returns variable notinvpt=1 if items not stored in inventory point

 ;  returns variable prcpflag=1 if user ^ during display

 ;  returns ^tmp($j,"prcpcdir",itemda)=qty needed ^ inventory value

 N %,CCIKITEM,DATA,INVVAL,ITEMDATA,NEWQTY,REUSABLE,SCREEN

 K ^TMP($J,"PRCPCDIR"),NOTINVPT,PRCPFLAG

 W ! D H

 S SCREEN=1,CCIKITEM=0 F  S CCIKITEM=$O(^PRCP(445,PRCP("I"),1,ITEMDA,8,CCIKITEM)) Q:'CCIKITEM!($G(PRCPFLAG))  S DATA=$P(^(CCIKITEM,0),"^",2)*QUANTITY D

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

 .   I ITEMDATA'="",$P(ITEMDATA,"^",7)="" S $P(ITEMDATA,"^",7)=0

 .   I ITEMDATA="" S $P(ITEMDATA,"^",7)="Not in InvPt" S NOTINVPT=1

 .   S INVVAL=$J($S('$P(ITEMDATA,"^",7):0,1:$P(ITEMDATA,"^",27)/$P(ITEMDATA,"^",7))*DATA,0,3)

 .   S NEWQTY=$P(ITEMDATA,"^",7)+DATA

 .   W !,CCIKITEM,?7,$E($$DESCR^PRCPUX1(PRCP("I"),CCIKITEM),1,22),?44,$J($P(ITEMDATA,"^",7),13),$J(DATA,10),$J(NEWQTY,13)

 .   S ^TMP($J,"PRCPCDIR",CCIKITEM)=DATA_"^"_INVVAL

 .   S SCREEN=SCREEN+1

 .   I SCREEN'<IOSL D P^PRCPUREP Q:$D(PRCPFLAG)  D H S SCREEN=1

 Q

 ;

 ;

H ;  display header on display

 W !?44,$J("CURRENT",13),$J("QTY",10),$J("** NEW **",13),!,"IM#",?7,"DESCRIPTION",?44,$J("QTY ON-HAND",13),$J("NEEDED",10),$J("QTY ON-HAND",13)

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

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPCDIR   1519     printed  Apr 09, 2024@21:16:57                                                                                                                                                                                                    Page 2

PRCPCDIR  ;WISC/RFJ-disassemble cc or ik (print items)               ;01 Sep 93

 +1       ;;5.1;IFCAP;;Oct 20, 2000

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        QUIT 

 +4       ;

 +5       ;

PRINT(ITEMDA,QUANTITY) ;  print items to disassemble

 +1       ;  returns variable notinvpt=1 if items not stored in inventory point

 +2       ;  returns variable prcpflag=1 if user ^ during display

 +3       ;  returns ^tmp($j,"prcpcdir",itemda)=qty needed ^ inventory value

 +4        NEW %,CCIKITEM,DATA,INVVAL,ITEMDATA,NEWQTY,REUSABLE,SCREEN

 +5        KILL ^TMP($JOB,"PRCPCDIR"),NOTINVPT,PRCPFLAG

 +6        WRITE !

           DO H

 +7        SET SCREEN=1

           SET CCIKITEM=0

           FOR 

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

               if 'CCIKITEM!($GET(PRCPFLAG))

                   QUIT 

               SET DATA=$PIECE(^(CCIKITEM,0),"^",2)*QUANTITY

               Begin DoDot:1

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

 +9                IF ITEMDATA'=""

                       IF $PIECE(ITEMDATA,"^",7)=""

                           SET $PIECE(ITEMDATA,"^",7)=0

 +10               IF ITEMDATA=""

                       SET $PIECE(ITEMDATA,"^",7)="Not in InvPt"

                       SET NOTINVPT=1

 +11               SET INVVAL=$JUSTIFY($SELECT('$PIECE(ITEMDATA,"^",7):0,1:$PIECE(ITEMDATA,"^",27)/$PIECE(ITEMDATA,"^",7))*DATA,0,3)

 +12               SET NEWQTY=$PIECE(ITEMDATA,"^",7)+DATA

 +13               WRITE !,CCIKITEM,?7,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),CCIKITEM),1,22),?44,$JUSTIFY($PIECE(ITEMDATA,"^",7),13),$JUSTIFY(DATA,10),$JUSTIFY(NEWQTY,13)

 +14               SET ^TMP($JOB,"PRCPCDIR",CCIKITEM)=DATA_"^"_INVVAL

 +15               SET SCREEN=SCREEN+1

 +16               IF SCREEN'<IOSL

                       DO P^PRCPUREP

                       if $DATA(PRCPFLAG)

                           QUIT 

                       DO H

                       SET SCREEN=1

               End DoDot:1

 +17       QUIT 

 +18      ;

 +19      ;

H         ;  display header on display

 +1        WRITE !?44,$JUSTIFY("CURRENT",13),$JUSTIFY("QTY",10),$JUSTIFY("** NEW **",13),!,"IM#",?7,"DESCRIPTION",?44,$JUSTIFY("QTY ON-HAND",13),$JUSTIFY("NEEDED",10),$JUSTIFY("QTY ON-HAND",13)

 +2        SET %=""

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

           WRITE !,%

 +3        QUIT