source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPOPR.m@ 897

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1PRCPOPR ;WISC/RFJ-release distribution order ;27 Sep 93
2V ;;5.1;IFCAP;**1,24**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6 ;
7RELEASEL ; release order - called from list manager
8 S VALMBCK="R"
9 N %,ITEMDA,PRCPFLAG
10 ;
11 W !!,"CHECKING ITEMS ON ORDER..."
12 S (ITEMDA,PRCPFLAG)=0 F S ITEMDA=$O(^PRCP(445.3,ORDERDA,1,ITEMDA)) Q:'ITEMDA I $P($G(^(ITEMDA,0)),"^",2),$$ITEMCHK^PRCPOPER(PRCPPRIM,PRCPSECO,ITEMDA)'="" S PRCPFLAG=1 Q
13 I PRCPFLAG S VALMSG="ORDER CANNOT BE RELEASED - FIX ALL ERRORS FIRST" D CHECKORD^PRCPOPER Q
14 W " NO ERRORS FOUND !",!
15 ;
16 I $$ASKREL(ORDERDA,1)'=1 Q
17 ;
18 D RELEASE(ORDERDA)
19 S VALMSG="ORDER HAS BEEN RELEASED (TO PRIMARY) FOR FILLING"
20 D HDR^PRCPOPL,VARIABLE^PRCPOPU
21 Q
22 ;
23 ;
24RELEASE(ORDERDA) ; release order - update dueouts and dueins, set order status released
25 N %,ITEMDA,ORDRDATA,PRCPPRIM,PRCPSECO,QUANTITY
26 S ORDRDATA=$G(^PRCP(445.3,ORDERDA,0)),PRCPPRIM=$P(ORDRDATA,"^",2),PRCPSECO=$P(ORDRDATA,"^",3)
27 S ITEMDA=0 F S ITEMDA=$O(^PRCP(445.3,ORDERDA,1,ITEMDA)) Q:'ITEMDA S QUANTITY=$P(^(ITEMDA,0),"^",2) I QUANTITY D DUEOUTIN^PRCPOPU(PRCPPRIM,PRCPSECO,ITEMDA,QUANTITY,0)
28 ;
29 S $P(^PRCP(445.3,ORDERDA,0),"^",6)="R"
30 ;
31 ; if this is a regular order for a supply station secondary, send the
32 ; order to the supply station and set up field 10.
33 I $P(^PRCP(445.3,ORDERDA,0),"^",8)="R",$P($G(^PRCP(445,PRCPSECO,5)),"^",1)]"" D
34 . N FLAG,ITEM
35 . I $P($G(^PRCP(445.3,ORDERDA,2)),"^",1)]"" D EN^DDIOL("Case Cart or IK Orders are not handled by the supply station.") Q ; CC/IK don't go
36 . S ITEM=0,FLAG=0
37 . F S ITEM=$O(^PRCP(445.3,ORDERDA,1,ITEM)) Q:+ITEM=0 D I FLAG Q
38 . . I $P(^PRC(441,ITEM,0),"^",6)'="S" S FLAG=1
39 . I 'FLAG D EN^DDIOL("Case Cart or IK Orders are not handled by the supply station.") Q
40 . D BLDSEG^PRCPHLSO(ORDERDA)
41 . D NOW^%DTC
42 . S $P(^PRCP(445.3,ORDERDA,0),"^",10)=%
43 ;
44 Q
45 ;
46ASKREL(ORDERDA,%) ; ask to release order, %=defualt
47 ; returns 1 for yes, 2 for no, 0 for ^
48 S XP="Is this order READY to be RELEASED to "_$$INVNAME^PRCPUX1(+$P($G(^PRCP(445.3,+ORDERDA,0)),"^",2))_" for FILLING",XH="Enter 'YES' to RELEASE this order for filling, 'NO' or '^' to exit."
49 W !
50 Q $$YN^PRCPUYN(%)
51 ;
52 ;
53 ; remove piece 10 from file 445.3 for order sent to supply station
54REMFLAG I '$D(PRCP("DPTYPE")) S PRCP("DPTYPE")="P"
55 D ^PRCPUSEL I '$G(PRCP("I")) Q
56 N DA,DIE,DIR,DR,ORDERDA,PRCPPRIM,PRCPSEC,PRCPSTOP,REFILL,Y
57 S PRCPPRIM=PRCP("I")
58 ; ask order number
59 S ORDERDA=$$ORDERSEL^PRCPOPUS(PRCPPRIM,0,"R","")
60 Q:'ORDERDA
61 S PRCPSEC=$P(^PRCP(445.3,ORDERDA,0),"^",10)
62 I PRCPSEC']"" D EN^DDIOL("This order is not a supply station order and has no flag to remove.") QUIT
63 S DIR(0)="Y"
64 S DIR("A")="Restrict all processing of this order to GIP"
65 S DIR("A",1)=" "
66 S DIR("A",2)="WARNING: RESTRICTIONS MAY COMPROMISE THE INTEGRITY OF INVENTORY DATA !!!"
67 S DIR("A",3)=" "
68 S DIR("A",4)="Restrict processing ONLY when a supply station or its interface is"
69 S DIR("A",5)="down for extended periods of time."
70 S DIR("B")="NO"
71 D ^DIR
72 K DIR
73 I Y'=1 QUIT
74 S PRCPSTOP=0
75 S REFILL=$$REFILL^PRCPOPD(+ORDERDA)
76 I REFILL D I PRCPSTOP QUIT
77 . N DA,DIR,DR
78 . S DIR(0)="Y"
79 . S DIR("A",1)=" "
80 . S DIR("A",2)="WARNING: The supply station stocked items in this order!!!"
81 . S DIR("A",3)=" THE STOCKED QUANTITIES WILL BE LOST IF YOU PROCEED."
82 . S DIR("A",4)=" "
83 . S DIR("A")="Are you sure you want to process the order in GIP instead"
84 . S DIR("?")="Enter 'Y' or 'YES' to process the order in GIP."
85 . S DIR("?",1)="Enter 'N' or 'NO' to process the order in the supply station."
86 . D ^DIR
87 . I $D(DUOUT)!$D(DTOUT) S PRCPSTOP=1 Q
88 . I Y=0 S PRCPSTOP=1 Q
89 ;
90 ; DELETE FLAG FROM ORDER
91 I REFILL D MESSAGE^PRCPOPD(+ORDERDA,2)
92 S DIE="^PRCP(445.3,"
93 S DA=ORDERDA
94 S DR="10///@"
95 D ^DIE
96 Q
Note: See TracBrowser for help on using the repository browser.