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

RMPFET10.m

Go to the documentation of this file.
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