Routine: PRCPOPP2

PRCPOPP2 ;WISC/RFJ-case cart/instrument kit post items              ;27 Sep 93

 ;;5.1;IFCAP;;Oct 20, 2000

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

POST ;  post cc's and ik's including items in cc's and ik's

 S VALMBCK="R"

 N CCIKITEM,DATA,ITEMDA,PRCPFLAG,QTYPOST

 W !!,"CHECKING CASE CART AND INSTRUMENT KIT ITEMS ON ORDER..."

 S (CCIKITEM,PRCPFLAG)=0 F  S CCIKITEM=$O(^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM)) Q:'CCIKITEM!(PRCPFLAG)  D

 .   I $$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,CCIKITEM)'="" S PRCPFLAG=1 Q

 .   S ITEMDA=0 F  S ITEMDA=$O(^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM,ITEMDA)) Q:'ITEMDA  S DATA=^(ITEMDA) D

 .   .   S QTYPOST=$P(DATA,"^")-$P(DATA,"^",2)

 .   .   ;  if reusable items returned, do nothing

 .   .   I $$REUSABLE^PRCPU441(ITEMDA),'QTYPOST Q

 .   .   I $$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,ITEMDA)'="" S PRCPFLAG=1 Q

 I PRCPFLAG S VALMSG="ORDER CANNOT BE POSTED - FIX ALL ERRORS FIRST" D EN^VALM("PRCP DIST ORDER CC/IK CHECK") Q

 W " NO ERRORS FOUND !",!

 S XP="Are you sure you want to POST the CC/IK items to "_$$INVNAME^PRCPUX1(PRCPSECO),XH="Enter 'YES' to start posting the CC/IK items to the secondary inventory point",XH(1)="Enter 'NO' or '^' to exit."

 W ! I $$YN^PRCPUYN(1)'=1 Q

 W !,"POSTING CASE CART AND INSTRUMENT KIT ITEMS ..."

 D POST^PRCPOPP3

 S VALMQUIT=1

 K VALMBCK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPOPP2   1374     printed  Apr 09, 2024@21:16:13                                                                                                                                                                                                    Page 2

PRCPOPP2  ;WISC/RFJ-case cart/instrument kit post items              ;27 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       ;

POST      ;  post cc's and ik's including items in cc's and ik's

 +1        SET VALMBCK="R"

 +2        NEW CCIKITEM,DATA,ITEMDA,PRCPFLAG,QTYPOST

 +3       ;

 +4        WRITE !!,"CHECKING CASE CART AND INSTRUMENT KIT ITEMS ON ORDER..."

 +5        SET (CCIKITEM,PRCPFLAG)=0

FOR

               SET CCIKITEM=$ORDER(^TMP($JOB,"PRCPOPPC-ITEMS",CCIKITEM))

               if 'CCIKITEM!(PRCPFLAG)

                   QUIT

               Begin DoDot:1

 +6                IF $$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,CCIKITEM)'=""

                       SET PRCPFLAG=1

                       QUIT

 +7                SET ITEMDA=0

FOR

                       SET ITEMDA=$ORDER(^TMP($JOB,"PRCPOPPC-ITEMS",CCIKITEM,ITEMDA))

                       if 'ITEMDA

                           QUIT

                       SET DATA=^(ITEMDA)

                       Begin DoDot:2

 +8                        SET QTYPOST=$PIECE(DATA,"^")-$PIECE(DATA,"^",2)

 +9       ;  if reusable items returned, do nothing

 +10                       IF $$REUSABLE^PRCPU441(ITEMDA)

                               IF 'QTYPOST

                                   QUIT

 +11                       IF $$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,ITEMDA)'=""

                               SET PRCPFLAG=1

                               QUIT

                       End DoDot:2

               End DoDot:1

 +12      ;

 +13       IF PRCPFLAG

               SET VALMSG="ORDER CANNOT BE POSTED - FIX ALL ERRORS FIRST"

               DO EN^VALM("PRCP DIST ORDER CC/IK CHECK")

               QUIT

 +14       WRITE " NO ERRORS FOUND !",!

 +15      ;

 +16       SET XP="Are you sure you want to POST the CC/IK items to "_$$INVNAME^PRCPUX1(PRCPSECO)

           SET XH="Enter 'YES' to start posting the CC/IK items to the secondary inventory point"

           SET XH(1)="Enter 'NO' or '^' to exit."

 +17       WRITE !

           IF $$YN^PRCPUYN(1)'=1

               QUIT

 +18       WRITE !,"POSTING CASE CART AND INSTRUMENT KIT ITEMS ..."

 +19       DO POST^PRCPOPP3

 +20       SET VALMQUIT=1

 +21       KILL VALMBCK

 +22       QUIT

PRCPOPP2.m