MCARAM0B ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-TRAN CORRES EKG ;2/24/95 10:50
;;2.3;Medicine;;09/13/1996
;
;
; Called from ^MCARAM0
; Deletes EKG records without corresponding dated transaction records
; Deletes Error Summary records without corresponding dated EKG records
N MCNAME,MCSSN,MCDATE,MCIEN,MCROOT,DA,DIK
S (MCIEN,MCDATE)=0
S MCROOT="^MCAR(691.5,"
F S MCDATE=$O(^MCAR(691.5,"B",MCDATE)) Q:MCDATE="" S MCIEN=0 F S MCIEN=$O(^MCAR(691.5,"B",MCDATE,MCIEN)) Q:MCIEN="" I '$D(^MCAR(700.5,"B",MCDATE)) D DEL
S MCROOT="^MCAR(700.5,",MCDATE=0,MCIEN=0
F S MCDATE=$O(^MCAR(700.5,"B",MCDATE)) Q:MCDATE="" S MCIEN=0 F S MCIEN=$O(^MCAR(700.5,"B",MCDATE,MCIEN)) Q:MCIEN="" I '$D(^MCAR(691.5,"B",MCDATE)) D DEL
Q
DEL ;
S MCCNT=MCCNT+1
S DIK=MCROOT,DA=MCIEN D ^DIK
W:MCCNT#100=0 "."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM0B 829 printed Nov 22, 2024@17:21:57 Page 2
MCARAM0B ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-TRAN CORRES EKG ;2/24/95 10:50
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
+4 ; Called from ^MCARAM0
+5 ; Deletes EKG records without corresponding dated transaction records
+6 ; Deletes Error Summary records without corresponding dated EKG records
+7 NEW MCNAME,MCSSN,MCDATE,MCIEN,MCROOT,DA,DIK
+8 SET (MCIEN,MCDATE)=0
+9 SET MCROOT="^MCAR(691.5,"
+10 FOR
SET MCDATE=$ORDER(^MCAR(691.5,"B",MCDATE))
if MCDATE=""
QUIT
SET MCIEN=0
FOR
SET MCIEN=$ORDER(^MCAR(691.5,"B",MCDATE,MCIEN))
if MCIEN=""
QUIT
IF '$DATA(^MCAR(700.5,"B",MCDATE))
DO DEL
+11 SET MCROOT="^MCAR(700.5,"
SET MCDATE=0
SET MCIEN=0
+12 FOR
SET MCDATE=$ORDER(^MCAR(700.5,"B",MCDATE))
if MCDATE=""
QUIT
SET MCIEN=0
FOR
SET MCIEN=$ORDER(^MCAR(700.5,"B",MCDATE,MCIEN))
if MCIEN=""
QUIT
IF '$DATA(^MCAR(691.5,"B",MCDATE))
DO DEL
+13 QUIT
DEL ;
+1 SET MCCNT=MCCNT+1
+2 SET DIK=MCROOT
SET DA=MCIEN
DO ^DIK
+3 if MCCNT#100=0
WRITE "."
+4 QUIT
