source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFET10.m@ 1800

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

initial load of WorldVistAEHR

File size: 964 bytes
RevLine 
[613]1RMPFET10 ;DDC/KAW-CHANGE STATUS OF ORDER WITH ERROR [ 06/27/97 11:15 AM ]
2 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**2,7,16**;JUN 16, 1995
3REMOV ;;Remove order from open batch
4 ;; input: RMPFX
5 ;;output: None
6 S RMPFBT=0
7 S:'$D(RMPFSTAP) RMPFSTAP=$G(^RMPF(791810,RMPFX,"STA"))
8 I '$D(RMPFMENU),$D(^RMPF(791810,RMPFX,0)) S RMPFMENU=$P(^(0),U,15)
9 Q:'$L(RMPFSTAP) Q:'$D(RMPFMENU)
10 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
11 G REMOVE:'RMPFBT
12 S X=$O(^RMPF(791812,RMPFBT,101,"B",RMPFX,0)) G REMOVE:'X
13 S DIK="^RMPF(791812,"_RMPFBT_",101,",DA(1)=RMPFBT,DA=X D ^DIK
14 I $D(^RMPF(791812,RMPFBT,101,0)),$P(^(0),U,4) G REMOVE
15 S DIK="^RMPF(791812,",DA=RMPFBT D ^DIK
16REMOVE K I,RMPFBT,S1,X,DIK,DA,%,DIC,Y Q
17READ K RMPFOUT,RMPFQUT
18 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U
19 I Y?1"^".E S (RMPFOUT,Y)="" Q
20 S:Y?1"?".E (RMPFQUT,Y)=""
21 Q
Note: See TracBrowser for help on using the repository browser.