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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPFET10 985 printed Dec 13, 2024@02:36:16 Page 2
RMPFET10 ;DDC/KAW-CHANGE STATUS OF ORDER WITH ERROR [ 06/27/97 11:15 AM ]
+1 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**2,7,16**;JUN 16, 1995
REMOV ;;Remove order from open batch
+1 ;; input: RMPFX
+2 ;;output: None
+3 SET RMPFBT=0
+4 if '$DATA(RMPFSTAP)
SET RMPFSTAP=$GET(^RMPF(791810,RMPFX,"STA"))
+5 IF '$DATA(RMPFMENU)
IF $DATA(^RMPF(791810,RMPFX,0))
SET RMPFMENU=$PIECE(^(0),U,15)
+6 if '$LENGTH(RMPFSTAP)
QUIT
if '$DATA(RMPFMENU)
QUIT
+7 FOR I=1:1
SET RMPFBT=$ORDER(^RMPF(791812,"C",1,RMPFBT))
if 'RMPFBT
QUIT
SET S1=$GET(^RMPF(791812,RMPFBT,0))
IF $PIECE($PIECE(S1,U,8)," - ",1)=$PIECE(RMPFSTAP," - ",1)
SET X=$PIECE(S1,U,9)
if X=""
SET X=0
IF X=RMPFMENU
QUIT
+8 if 'RMPFBT
GOTO REMOVE
+9 SET X=$ORDER(^RMPF(791812,RMPFBT,101,"B",RMPFX,0))
if 'X
GOTO REMOVE
+10 SET DIK="^RMPF(791812,"_RMPFBT_",101,"
SET DA(1)=RMPFBT
SET DA=X
DO ^DIK
+11 IF $DATA(^RMPF(791812,RMPFBT,101,0))
IF $PIECE(^(0),U,4)
GOTO REMOVE
+12 SET DIK="^RMPF(791812,"
SET DA=RMPFBT
DO ^DIK
REMOVE KILL I,RMPFBT,S1,X,DIK,DA,%,DIC,Y
QUIT
READ KILL RMPFOUT,RMPFQUT
+1 READ Y:DTIME
IF '$TEST
WRITE $CHAR(7)
READ Y:5
if Y="."
GOTO READ
if '$TEST
SET Y=U
+2 IF Y?1"^".E
SET (RMPFOUT,Y)=""
QUIT
+3 if Y?1"?".E
SET (RMPFQUT,Y)=""
+4 QUIT
