source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPOPEC.m@ 770

Last change on this file since 770 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1PRCPOPEC ;WISC/RFJ-distribution order error report for cc,ik items ;27 Sep 93
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7INIT ; check order for errors and build array
8 N DATA,ITEMDA,QTYORDER
9 K ^TMP($J,"PRCPOPER")
10 S VALMCNT=0
11 S CCIKITEM=0 F S CCIKITEM=$O(^TMP($J,"PRCPOPPC-ITEMS",CCIKITEM)) Q:'CCIKITEM D
12 . S QTYORDER=$P($G(^PRCP(445.3,ORDERDA,1,CCIKITEM,0)),"^",2)
13 . D SETERROR(CCIKITEM)
14 . ; check items to post
15 . 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
16 . . ; do not check cc/ik items twice
17 . . I $D(^TMP($J,"PRCPOPPC-ITEMS",ITEMDA)) Q
18 . . D SETERROR(ITEMDA)
19 ;
20 I VALMCNT=0 S VALMQUIT=1,VALMSG="* * * NO ERRORS FOUND * * *"
21 Q
22 ;
23 ;
24EXIT ; exit and clean up
25 K ^TMP($J,"PRCPOPER")
26 Q
27 ;
28 ;
29EEITEMS ; called from protocol file to enter/edit invpt items
30 N PRC,PRCP
31 S PRCP("DPTYPE")="PS"
32 D ^PRCPEILM
33 D INIT
34 S VALMBCK="R"
35 I $G(VALMQUIT) K VALMBCK
36 Q
37 ;
38 ;
39SETERROR(ITEMDA) ; set error in list for itemda
40 N ERROR
41 S ERROR=$$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,ITEMDA)
42 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 **"
43 I ERROR="" Q
44 D BLDARRAY^PRCPOPL(PRCPPRIM,PRCPSECO,ITEMDA,QTYORDER)
45 F %=1:1 Q:$P(ERROR,"^",%,99)="" I $P(ERROR,"^",%)'="" D SET^PRCPOPL($P(ERROR,"^",%))
46 Q
Note: See TracBrowser for help on using the repository browser.