40 lines
1.6 KiB
Mathematica
40 lines
1.6 KiB
Mathematica
RMPFQS1 ;DDC/KAW-CONTINUATION OF RMPFQS [ 08/25/97 12:02 PM ]
|
|
;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8**;MAY 30, 1995
|
|
PURGE ;; input: RMPFP
|
|
;;output; RMPFCX
|
|
S RMPFORD="S",RMPFTP="B",RMPFCX=0
|
|
S RMPF=$O(^RMPF(791810.5,"C",RMPFMENU,0)) D HEAD:$D(RMPFL)
|
|
S RMPFX=0,DIK="^RMPF(791810,"
|
|
F S RMPFX=$O(^RMPF(791810,RMPFX)) Q:'RMPFX D KILL Q:$D(RMPFOUT)
|
|
I RMPFCX=0 W:'$D(ZTSK) !!,"*** NO ORDERS TO PURGE ***" G PURGEE
|
|
W:'$D(ZTSK) !!,"Number of Orders to be Purged: ",RMPFCX G PURGEE
|
|
D:$D(IO("S")) ^%ZISC
|
|
PURGEE K I,DIK,DIC,RMPFTP,RMPFORD,I,RMPFOUT,RMPFQUT,RMPFX,X,RMPF Q
|
|
KILL ;; input: RMPFX,RMPFP,RMPFL,DIK,RMPF
|
|
;;output: None
|
|
Q:'$D(^RMPF(791810,RMPFX,0)) S S0=^(0),X=$P(S0,U,15) Q:X'=RMPF
|
|
S RMPFST=$P(S0,U,3) I 'RMPFST K S0,RMPFST Q
|
|
I '$D(RMPFP(RMPFST)) K S0,RMPFST Q
|
|
S RMPFTD=$P(S0,U,6),X1=DT,X2="-"_RMPFP(RMPFST) S:'X2 X2=-30 D C^%DTC
|
|
G KILLE:RMPFTD>X
|
|
I '$D(RMPFL) S DA=RMPFX D ^DIK S RMPFCX=RMPFCX+1
|
|
I $D(RMPFL) D SUB^RMPFDS1 D
|
|
.I IOST?1"C-".E,$Y>20 W !!,"Enter <RETURN> to continue or <^> to exit." D READ^RMPFQS D HEAD:'$D(RMPFOUT)
|
|
.I IOST?1"P-".E,$Y>(IOSL-5) D HEAD
|
|
KILLE K S0,RMPFST,RMPFTD,X,RMPFST,X1,X2,DA,Y,%,RMPFS,T,J,RMPFSD,RMPFSSN
|
|
K RMPFNAM,RMPFDOB,RMPFDOD,RMPFMGG,DFN Q
|
|
BATCH ;; input: None
|
|
;;output: None
|
|
S BT=0
|
|
B1 S BT=$O(^RMPF(791812,BT)) G BATCHE:'BT,B1:'$D(^(BT,0)) S ST=$P(^(0),U,2) G B1:ST'=3 S PT=0
|
|
B2 S PT=$O(^RMPF(791812,BT,101,PT)) I 'PT D KILBAT G B1
|
|
G B2:'$D(^RMPF(791812,BT,101,PT,0)) S PX=$P(^(0),U,1)
|
|
G B2:'$D(^RMPF(791810,PX,0)) S SX=$P(^(0),U,3)
|
|
G B2:SX>4,B1
|
|
BATCHE K BT,PT,PX,SX,ST Q
|
|
KILBAT S DA=BT,DIK="^RMPF(791812," D ^DIK
|
|
Q
|
|
HEAD W @IOF,!?30,"ORDERS TO BE PURGED"
|
|
D HEADS1^RMPFDS1
|
|
Q
|