MCARAM0E ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-NOTED REC IN ERR ;1/31/95 11:30
;;2.3;Medicine;;09/13/1996
;
;
;Called from ^MCARAM0
;Delete automated EKGs that are marked for deletion
; and corresponding transaction records
N MCIEN,MCSTAT,MCTIEN,MCDATE,MCSSN
S (MCIEN,MCTIEN,MCDATE)=0
F S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN="B" I $D(^MCAR(691.5,MCIEN,"A")),$D(^MCAR(691.5,MCIEN,"ES")) S MCSTAT=$P(^MCAR(691.5,MCIEN,"ES"),"^",12) I MCSTAT=1 D DEL
Q
DEL ;
S MCTIEN=0
S MCSSN=^MCAR(691.5,MCIEN,.1)
S MCDATE=$P(^MCAR(691.5,MCIEN,0),"^")
F S MCTIEN=$O(^MCAR(700.5,"B",MCDATE,MCTIEN)) Q:MCTIEN="" I $P(^MCAR(700.5,MCTIEN,0),"^",3)=MCSSN S DIK="^MCAR(700.5,",DA=MCTIEN D ^DIK S DIK="^MCAR(691.5,",DA=MCIEN D ^DIK S MCCNT=MCCNT+1 W:MCCNT#100=0 "."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM0E 785 printed Nov 22, 2024@17:22 Page 2
MCARAM0E ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-NOTED REC IN ERR ;1/31/95 11:30
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
+4 ;Called from ^MCARAM0
+5 ;Delete automated EKGs that are marked for deletion
+6 ; and corresponding transaction records
+7 NEW MCIEN,MCSTAT,MCTIEN,MCDATE,MCSSN
+8 SET (MCIEN,MCTIEN,MCDATE)=0
+9 FOR
SET MCIEN=$ORDER(^MCAR(691.5,MCIEN))
if MCIEN="B"
QUIT
IF $DATA(^MCAR(691.5,MCIEN,"A"))
IF $DATA(^MCAR(691.5,MCIEN,"ES"))
SET MCSTAT=$PIECE(^MCAR(691.5,MCIEN,"ES"),"^",12)
IF MCSTAT=1
DO DEL
+10 QUIT
DEL ;
+1 SET MCTIEN=0
+2 SET MCSSN=^MCAR(691.5,MCIEN,.1)
+3 SET MCDATE=$PIECE(^MCAR(691.5,MCIEN,0),"^")
+4 FOR
SET MCTIEN=$ORDER(^MCAR(700.5,"B",MCDATE,MCTIEN))
if MCTIEN=""
QUIT
IF $PIECE(^MCAR(700.5,MCTIEN,0),"^",3)=MCSSN
SET DIK="^MCAR(700.5,"
SET DA=MCTIEN
DO ^DIK
SET DIK="^MCAR(691.5,"
SET DA=MCIEN
DO ^DIK
SET MCCNT=MCCNT+1
if MCCNT#100=0
WRITE "."
+5 QUIT
