22 lines
964 B
Mathematica
22 lines
964 B
Mathematica
RMPFET10 ;DDC/KAW-CHANGE STATUS OF ORDER WITH ERROR [ 06/27/97 11:15 AM ]
|
|
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**2,7,16**;JUN 16, 1995
|
|
REMOV ;;Remove order from open batch
|
|
;; input: RMPFX
|
|
;;output: None
|
|
S RMPFBT=0
|
|
S:'$D(RMPFSTAP) RMPFSTAP=$G(^RMPF(791810,RMPFX,"STA"))
|
|
I '$D(RMPFMENU),$D(^RMPF(791810,RMPFX,0)) S RMPFMENU=$P(^(0),U,15)
|
|
Q:'$L(RMPFSTAP) Q:'$D(RMPFMENU)
|
|
F I=1:1 S RMPFBT=$O(^RMPF(791812,"C",1,RMPFBT)) Q:'RMPFBT S S1=$G(^RMPF(791812,RMPFBT,0)) I $P($P(S1,U,8)," - ",1)=$P(RMPFSTAP," - ",1) S X=$P(S1,U,9) S:X="" X=0 I X=RMPFMENU Q
|
|
G REMOVE:'RMPFBT
|
|
S X=$O(^RMPF(791812,RMPFBT,101,"B",RMPFX,0)) G REMOVE:'X
|
|
S DIK="^RMPF(791812,"_RMPFBT_",101,",DA(1)=RMPFBT,DA=X D ^DIK
|
|
I $D(^RMPF(791812,RMPFBT,101,0)),$P(^(0),U,4) G REMOVE
|
|
S DIK="^RMPF(791812,",DA=RMPFBT D ^DIK
|
|
REMOVE K I,RMPFBT,S1,X,DIK,DA,%,DIC,Y Q
|
|
READ K RMPFOUT,RMPFQUT
|
|
R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
|
|
I Y?1"^".E S (RMPFOUT,Y)="" Q
|
|
S:Y?1"?".E (RMPFQUT,Y)=""
|
|
Q
|