| 1 | QAMARCH1 ;HISC/DAD-SELECTIVELY PURGE FILES 743.1, 743.2, 743.6 ;1/8/93 14:20
|
|---|
| 2 | ;;1.0;Clinical Monitoring System;;09/13/1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN1 ; *** MONITOR HISTORY FILE (#743.2)
|
|---|
| 5 | 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
|
|---|
| 6 | . 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
|
|---|
| 7 | . Q
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | EN2 ; *** FALL OUT FILE (#743.1)
|
|---|
| 11 | S QAMDELET=$S($D(^DD(743.1,.01,"DEL",1,0))#2:^(0),1:""),QAMMONNM=""
|
|---|
| 12 | 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
|
|---|
| 13 | . 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
|
|---|
| 14 | . Q
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | EN3 ; *** AUTO ENROLL RUN DATES FILE (#743.6) (CALLED BY QAOSPURG)
|
|---|
| 18 | 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
|
|---|
| 19 | . F QAMD0=0:0 S QAMD0=$O(^QA(743.6,"AM",QAMMON,QAMD0)) Q:QAMD0'>0 D
|
|---|
| 20 | .. F QAMD1=0:0 S QAMD1=$O(^QA(743.6,"AM",QAMMON,QAMD0,QAMD1)) Q:QAMD1'>0 D
|
|---|
| 21 | ... S QAMDATE=$S($D(^QA(743.6,QAMD0,0))#2:+^(0),1:0)
|
|---|
| 22 | ... S DIK="^QA(743.6,"_QAMD0_",1,",DA(1)=QAMD0,DA=QAMD1 D DELETE
|
|---|
| 23 | ... Q
|
|---|
| 24 | .. I $O(^QA(743.6,QAMD0,1,0))'>0 S QAMDATE=QAQNBEG,DIK="^QA(743.6,",DA=QAMD0 D DELETE
|
|---|
| 25 | .. Q
|
|---|
| 26 | . Q
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | DELETE ; *** DELETE AN ENTRY
|
|---|
| 30 | Q:(QAMDATE<QAQNBEG)!(QAMDATE>(QAQNEND+.9999999)) D ^DIK
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | HIST ; *** UPDATE HISTORY FILE (#743.2) WHEN FALL OUT FILE (#743.1) IS PURGED
|
|---|
| 34 | Q:(QAMDATE<QAQNBEG)!(QAMDATE>(QAQNEND+.9999999))
|
|---|
| 35 | N QAMD0,QAMTODAY S QAMD0=QAMMON,QAMTODAY=QAMDATE
|
|---|
| 36 | D EN^QAMTIME0 Q:(QAMSTART'>0)!(QAMEND'>0)
|
|---|
| 37 | Q:(QAMDATE<QAMSTART)!(QAMDATE>QAMEND)
|
|---|
| 38 | S QAMS0=$O(^QA(743.2,"AA",QAMMON,QAMSTART,QAMEND,0))
|
|---|
| 39 | I QAMS0 D
|
|---|
| 40 | . S QAMZERO=$G(^QA(743.2,QAMS0,0))
|
|---|
| 41 | . S QAMFALL=$P(QAMZERO,"^",4) I QAMFALL D
|
|---|
| 42 | .. S QAMFALL=QAMFALL-1
|
|---|
| 43 | .. S DIE="^QA(743.2,",DR="1///^S X=QAMFALL",DA=QAMS0 D ^DIE
|
|---|
| 44 | .. Q
|
|---|
| 45 | . S QAMSAMP=$P(QAMZERO,"^",5) I QAMSAMP D
|
|---|
| 46 | .. S QAMSAMP=QAMSAMP-1
|
|---|
| 47 | .. S DIE="^QA(743.2,",DR="2///^S X=QAMSAMP",DA=QAMS0 D ^DIE
|
|---|
| 48 | .. Q
|
|---|
| 49 | . Q
|
|---|
| 50 | Q
|
|---|
