source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMARCH1.m@ 1710

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1QAMARCH1 ;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 ;
4EN1 ; *** 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 ;
10EN2 ; *** 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 ;
17EN3 ; *** 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 ;
29DELETE ; *** DELETE AN ENTRY
30 Q:(QAMDATE<QAQNBEG)!(QAMDATE>(QAQNEND+.9999999)) D ^DIK
31 Q
32 ;
33HIST ; *** 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
Note: See TracBrowser for help on using the repository browser.