QAMARCH1 ;HISC/DAD-SELECTIVELY PURGE FILES 743.1, 743.2, 743.6 ;1/8/93  14:20
 ;;1.0;Clinical Monitoring System;;09/13/1993
 ;
EN1 ; *** MONITOR HISTORY FILE (#743.2)
 S QAMMONNM="" F QAMMONNM(0)=0:0 S QAMMONNM=$O(^UTILITY($J,"QAM MONITOR",QAMMONNM)) Q:QAMMONNM=""  F QAMMON=0:0 S QAMMON=$O(^UTILITY($J,"QAM MONITOR",QAMMONNM,QAMMON)) Q:QAMMON'>0  D
 . F QAMD0=0:0 S QAMD0=$O(^QA(743.2,"B",QAMMON,QAMD0)) Q:QAMD0'>0  S QAMDATE=$S($D(^QA(743.2,QAMD0,0))#2:$P(^(0),"^",2),1:0),DIK="^QA(743.2,",DA=QAMD0 D DELETE
 . Q
 Q
 ;
EN2 ; *** FALL OUT FILE (#743.1)
 S QAMDELET=$S($D(^DD(743.1,.01,"DEL",1,0))#2:^(0),1:""),QAMMONNM=""
 F QAMMONNM(0)=0:0 S QAMMONNM=$O(^UTILITY($J,"QAM MONITOR",QAMMONNM)) Q:QAMMONNM=""  F QAMMON=0:0 S QAMMON=$O(^UTILITY($J,"QAM MONITOR",QAMMONNM,QAMMON)) Q:QAMMON'>0  D
 . F QAMD0=0:0 S QAMD0=$O(^QA(743.1,"C",QAMMON,QAMD0)) Q:QAMD0'>0  S QAMDATE=$S($D(^QA(743.1,QAMD0,0))#2:$P(^(0),"^",3),1:0) D HIST S DIK="^QA(743.1,",DA=QAMD0 X QAMDELET D DELETE
 . Q
 Q
 ;
EN3 ; *** AUTO ENROLL RUN DATES FILE (#743.6)   (CALLED BY QAOSPURG)
 S QAMMONNM="" F QAMMONNM(0)=0:0 S QAMMONNM=$O(^UTILITY($J,"QAM MONITOR",QAMMONNM)) Q:QAMMONNM=""  F QAMMON=0:0 S QAMMON=$O(^UTILITY($J,"QAM MONITOR",QAMMONNM,QAMMON)) Q:QAMMON'>0  D
 . F QAMD0=0:0 S QAMD0=$O(^QA(743.6,"AM",QAMMON,QAMD0)) Q:QAMD0'>0  D
 .. F QAMD1=0:0 S QAMD1=$O(^QA(743.6,"AM",QAMMON,QAMD0,QAMD1)) Q:QAMD1'>0  D
 ... S QAMDATE=$S($D(^QA(743.6,QAMD0,0))#2:+^(0),1:0)
 ... S DIK="^QA(743.6,"_QAMD0_",1,",DA(1)=QAMD0,DA=QAMD1 D DELETE
 ... Q
 .. I $O(^QA(743.6,QAMD0,1,0))'>0 S QAMDATE=QAQNBEG,DIK="^QA(743.6,",DA=QAMD0 D DELETE
 .. Q
 . Q
 Q
 ;
DELETE ; *** DELETE AN ENTRY
 Q:(QAMDATE<QAQNBEG)!(QAMDATE>(QAQNEND+.9999999))  D ^DIK
 Q
 ;
HIST ; *** UPDATE HISTORY FILE (#743.2) WHEN FALL OUT FILE (#743.1) IS PURGED
 Q:(QAMDATE<QAQNBEG)!(QAMDATE>(QAQNEND+.9999999))
 N QAMD0,QAMTODAY S QAMD0=QAMMON,QAMTODAY=QAMDATE
 D EN^QAMTIME0 Q:(QAMSTART'>0)!(QAMEND'>0)
 Q:(QAMDATE<QAMSTART)!(QAMDATE>QAMEND)
 S QAMS0=$O(^QA(743.2,"AA",QAMMON,QAMSTART,QAMEND,0))
 I QAMS0 D
 . S QAMZERO=$G(^QA(743.2,QAMS0,0))
 . S QAMFALL=$P(QAMZERO,"^",4) I QAMFALL D
 .. S QAMFALL=QAMFALL-1
 .. S DIE="^QA(743.2,",DR="1///^S X=QAMFALL",DA=QAMS0 D ^DIE
 .. Q
 . S QAMSAMP=$P(QAMZERO,"^",5) I QAMSAMP D
 .. S QAMSAMP=QAMSAMP-1
 .. S DIE="^QA(743.2,",DR="2///^S X=QAMSAMP",DA=QAMS0 D ^DIE
 .. Q
 . Q
 Q