51 lines
2.3 KiB
Mathematica
51 lines
2.3 KiB
Mathematica
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
|