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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMARCH1 2393 printed Dec 13, 2024@01:41:43 Page 2
QAMARCH1 ;HISC/DAD-SELECTIVELY PURGE FILES 743.1, 743.2, 743.6 ;1/8/93 14:20
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 ;
EN1 ; *** MONITOR HISTORY FILE (#743.2)
+1 SET QAMMONNM=""
FOR QAMMONNM(0)=0:0
SET QAMMONNM=$ORDER(^UTILITY($JOB,"QAM MONITOR",QAMMONNM))
if QAMMONNM=""
QUIT
FOR QAMMON=0:0
SET QAMMON=$ORDER(^UTILITY($JOB,"QAM MONITOR",QAMMONNM,QAMMON))
if QAMMON'>0
QUIT
Begin DoDot:1
+2 FOR QAMD0=0:0
SET QAMD0=$ORDER(^QA(743.2,"B",QAMMON,QAMD0))
if QAMD0'>0
QUIT
SET QAMDATE=$SELECT($DATA(^QA(743.2,QAMD0,0))#2:$PIECE(^(0),"^",2),1:0)
SET DIK="^QA(743.2,"
SET DA=QAMD0
DO DELETE
+3 QUIT
End DoDot:1
+4 QUIT
+5 ;
EN2 ; *** FALL OUT FILE (#743.1)
+1 SET QAMDELET=$SELECT($DATA(^DD(743.1,.01,"DEL",1,0))#2:^(0),1:"")
SET QAMMONNM=""
+2 FOR QAMMONNM(0)=0:0
SET QAMMONNM=$ORDER(^UTILITY($JOB,"QAM MONITOR",QAMMONNM))
if QAMMONNM=""
QUIT
FOR QAMMON=0:0
SET QAMMON=$ORDER(^UTILITY($JOB,"QAM MONITOR",QAMMONNM,QAMMON))
if QAMMON'>0
QUIT
Begin DoDot:1
+3 FOR QAMD0=0:0
SET QAMD0=$ORDER(^QA(743.1,"C",QAMMON,QAMD0))
if QAMD0'>0
QUIT
SET QAMDATE=$SELECT($DATA(^QA(743.1,QAMD0,0))#2:$PIECE(^(0),"^",3),1:0)
DO HIST
SET DIK="^QA(743.1,"
SET DA=QAMD0
XECUTE QAMDELET
DO DELETE
+4 QUIT
End DoDot:1
+5 QUIT
+6 ;
EN3 ; *** AUTO ENROLL RUN DATES FILE (#743.6) (CALLED BY QAOSPURG)
+1 SET QAMMONNM=""
FOR QAMMONNM(0)=0:0
SET QAMMONNM=$ORDER(^UTILITY($JOB,"QAM MONITOR",QAMMONNM))
if QAMMONNM=""
QUIT
FOR QAMMON=0:0
SET QAMMON=$ORDER(^UTILITY($JOB,"QAM MONITOR",QAMMONNM,QAMMON))
if QAMMON'>0
QUIT
Begin DoDot:1
+2 FOR QAMD0=0:0
SET QAMD0=$ORDER(^QA(743.6,"AM",QAMMON,QAMD0))
if QAMD0'>0
QUIT
Begin DoDot:2
+3 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743.6,"AM",QAMMON,QAMD0,QAMD1))
if QAMD1'>0
QUIT
Begin DoDot:3
+4 SET QAMDATE=$SELECT($DATA(^QA(743.6,QAMD0,0))#2:+^(0),1:0)
+5 SET DIK="^QA(743.6,"_QAMD0_",1,"
SET DA(1)=QAMD0
SET DA=QAMD1
DO DELETE
+6 QUIT
End DoDot:3
+7 IF $ORDER(^QA(743.6,QAMD0,1,0))'>0
SET QAMDATE=QAQNBEG
SET DIK="^QA(743.6,"
SET DA=QAMD0
DO DELETE
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
DELETE ; *** DELETE AN ENTRY
+1 if (QAMDATE<QAQNBEG)!(QAMDATE>(QAQNEND+.9999999))
QUIT
DO ^DIK
+2 QUIT
+3 ;
HIST ; *** UPDATE HISTORY FILE (#743.2) WHEN FALL OUT FILE (#743.1) IS PURGED
+1 if (QAMDATE<QAQNBEG)!(QAMDATE>(QAQNEND+.9999999))
QUIT
+2 NEW QAMD0,QAMTODAY
SET QAMD0=QAMMON
SET QAMTODAY=QAMDATE
+3 DO EN^QAMTIME0
if (QAMSTART'>0)!(QAMEND'>0)
QUIT
+4 if (QAMDATE<QAMSTART)!(QAMDATE>QAMEND)
QUIT
+5 SET QAMS0=$ORDER(^QA(743.2,"AA",QAMMON,QAMSTART,QAMEND,0))
+6 IF QAMS0
Begin DoDot:1
+7 SET QAMZERO=$GET(^QA(743.2,QAMS0,0))
+8 SET QAMFALL=$PIECE(QAMZERO,"^",4)
IF QAMFALL
Begin DoDot:2
+9 SET QAMFALL=QAMFALL-1
+10 SET DIE="^QA(743.2,"
SET DR="1///^S X=QAMFALL"
SET DA=QAMS0
DO ^DIE
+11 QUIT
End DoDot:2
+12 SET QAMSAMP=$PIECE(QAMZERO,"^",5)
IF QAMSAMP
Begin DoDot:2
+13 SET QAMSAMP=QAMSAMP-1
+14 SET DIE="^QA(743.2,"
SET DR="2///^S X=QAMSAMP"
SET DA=QAMS0
DO ^DIE
+15 QUIT
End DoDot:2
+16 QUIT
End DoDot:1
+17 QUIT
