PRCPOPEC.m

PRCPOPEC ;WISC/RFJ-distribution order error report for cc,ik items  ;27 Sep 93

 ;;5.1;IFCAP;;Oct 20, 2000

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

 Q

 ;

 ;

INIT       ;  check order for errors and build array

 N DATA,ITEMDA,QTYORDER

 K ^TMP($J,"PRCPOPER")

 S VALMCNT=0

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

 .   S QTYORDER=$P($G(^PRCP(445.3,ORDERDA,1,CCIKITEM,0)),"^",2)

 .   D SETERROR(CCIKITEM)

 .   ;  check items to post

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

 .   .   ;  do not check cc/ik items twice

 .   .   I $D(^TMP($J,"PRCPOPPC-ITEMS",ITEMDA)) Q

 .   .   D SETERROR(ITEMDA)

 ;

 I VALMCNT=0 S VALMQUIT=1,VALMSG="* * * NO ERRORS FOUND * * *"

 Q

 ;

 ;

EXIT ;  exit and clean up

 K ^TMP($J,"PRCPOPER")

 Q

 ;

 ;

EEITEMS ;  called from protocol file to enter/edit invpt items

 N PRC,PRCP

 S PRCP("DPTYPE")="PS"

 D ^PRCPEILM

 D INIT

 S VALMBCK="R"

 I $G(VALMQUIT) K VALMBCK

 Q

 ;

 ;

SETERROR(ITEMDA) ;  set error in list for itemda

 N ERROR

 S ERROR=$$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,ITEMDA)

 I $P($G(^PRCP(445,PRCPPRIM,1,ITEMDA,0)),"^",7)<QTYORDER S ERROR=ERROR_$S(ERROR="":"",1:"^")_"    ** PRIMARY QUANTITY ON-HAND LESS THAN QUANTITY ON ORDER **"

 I ERROR="" Q

 D BLDARRAY^PRCPOPL(PRCPPRIM,PRCPSECO,ITEMDA,QTYORDER)

 F %=1:1 Q:$P(ERROR,"^",%,99)=""  I $P(ERROR,"^",%)'="" D SET^PRCPOPL($P(ERROR,"^",%))

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCPOPEC   1541     printed  Apr 09, 2024@21:13:50                                                                                                                                                                                                    Page 2

PRCPOPEC  ;WISC/RFJ-distribution order error report for cc,ik 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       ;

INIT      ;  check order for errors and build array

 +1        NEW DATA,ITEMDA,QTYORDER

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

 +3        SET VALMCNT=0

 +4        SET CCIKITEM=0

           FOR 

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

               if 'CCIKITEM

                   QUIT 

               Begin DoDot:1

 +5                SET QTYORDER=$PIECE($GET(^PRCP(445.3,ORDERDA,1,CCIKITEM,0)),"^",2)

 +6                DO SETERROR(CCIKITEM)

 +7       ;  check items to post

 +8                SET ITEMDA=0

                   FOR 

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

                       if 'ITEMDA

                           QUIT 

                       SET QTYORDER=$PIECE(^(ITEMDA),"^")-$PIECE(^(ITEMDA),"^",2)

                       IF QTYORDER

                           Begin DoDot:2

 +9       ;  do not check cc/ik items twice

 +10                           IF $DATA(^TMP($JOB,"PRCPOPPC-ITEMS",ITEMDA))

                                   QUIT 

 +11                           DO SETERROR(ITEMDA)

                           End DoDot:2

               End DoDot:1

 +12      ;

 +13       IF VALMCNT=0

               SET VALMQUIT=1

               SET VALMSG="* * * NO ERRORS FOUND * * *"

 +14       QUIT 

 +15      ;

 +16      ;

EXIT      ;  exit and clean up

 +1        KILL ^TMP($JOB,"PRCPOPER")

 +2        QUIT 

 +3       ;

 +4       ;

EEITEMS   ;  called from protocol file to enter/edit invpt items

 +1        NEW PRC,PRCP

 +2        SET PRCP("DPTYPE")="PS"

 +3        DO ^PRCPEILM

 +4        DO INIT

 +5        SET VALMBCK="R"

 +6        IF $GET(VALMQUIT)

               KILL VALMBCK

 +7        QUIT 

 +8       ;

 +9       ;

SETERROR(ITEMDA) ;  set error in list for itemda

 +1        NEW ERROR

 +2        SET ERROR=$$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,ITEMDA)

 +3        IF $PIECE($GET(^PRCP(445,PRCPPRIM,1,ITEMDA,0)),"^",7)<QTYORDER

               SET ERROR=ERROR_$SELECT(ERROR="":"",1:"^")_"    ** PRIMARY QUANTITY ON-HAND LESS THAN QUANTITY ON ORDER **"

 +4        IF ERROR=""

               QUIT 

 +5        DO BLDARRAY^PRCPOPL(PRCPPRIM,PRCPSECO,ITEMDA,QTYORDER)

 +6        FOR %=1:1

               if $PIECE(ERROR,"^",%,99)=""

                   QUIT 

               IF $PIECE(ERROR,"^",%)'=""

                   DO SET^PRCPOPL($PIECE(ERROR,"^",%))

 +7        QUIT