source: WorldVistAEHR/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFQS1.m@ 1111

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