Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCPOPEC

PRCPOPEC.m

Go to the documentation of this file.
  1. PRCPOPEC ;WISC/RFJ-distribution order error report for cc,ik items ;27 Sep 93
  1. ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. Q
  1. ;
  1. ;
  1. INIT ; check order for errors and build array
  1. N DATA,ITEMDA,QTYORDER
  1. K ^TMP($J,"PRCPOPER")
  1. S VALMCNT=0
  1. S CCIKITEM=0 F S CCIKITEM=$O(^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM)) Q:'CCIKITEM D
  1. . S QTYORDER=$P($G(^PRCP(445.3,ORDERDA,1,CCIKITEM,0)),"^",2)
  1. . D SETERROR(CCIKITEM)
  1. . ; check items to post
  1. . 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
  1. . . ; do not check cc/ik items twice
  1. . . I $D(^TMP($J,"PRCPOPPC-ITEMS",ITEMDA)) Q
  1. . . D SETERROR(ITEMDA)
  1. ;
  1. I VALMCNT=0 S VALMQUIT=1,VALMSG="* * * NO ERRORS FOUND * * *"
  1. Q
  1. ;
  1. ;
  1. EXIT ; exit and clean up
  1. K ^TMP($J,"PRCPOPER")
  1. Q
  1. ;
  1. ;
  1. EEITEMS ; called from protocol file to enter/edit invpt items
  1. N PRC,PRCP
  1. S PRCP("DPTYPE")="PS"
  1. D ^PRCPEILM
  1. D INIT
  1. S VALMBCK="R"
  1. I $G(VALMQUIT) K VALMBCK
  1. Q
  1. ;
  1. ;
  1. SETERROR(ITEMDA) ; set error in list for itemda
  1. N ERROR
  1. S ERROR=$$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,ITEMDA)
  1. 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 **"
  1. I ERROR="" Q
  1. D BLDARRAY^PRCPOPL(PRCPPRIM,PRCPSECO,ITEMDA,QTYORDER)
  1. F %=1:1 Q:$P(ERROR,"^",%,99)="" I $P(ERROR,"^",%)'="" D SET^PRCPOPL($P(ERROR,"^",%))
  1. Q