MCARAM0F ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-MISS TRAN REC ;1/31/95 11:31
;;2.3;Medicine;;09/13/1996
;
;
;Called from ^MCARAM0
;Deletes EKG records without transaction by IEN patient match
S (MCIEN,MCDATE,MCNAME,MCI,MCJ,MCZERO,MCK)=0
F S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN="B" S MCDATE=$P(^MCAR(691.5,MCIEN,0),"^"),MCSSN=^MCAR(691.5,MCIEN,.1) D CHECK
Q
CHECK ;
S MCI=0 F S MCERR=0,MCI=$O(^MCAR(700.5,"B",MCDATE,MCI)) Q:MCI="" S MCZERO=^MCAR(700.5,MCI,0) I $P(MCZERO,"^",3)=MCSSN S MCERR=MCIEN Q
I MCERR=0 D DEL Q
Q
DEL S DA=MCIEN,DIK="^MCAR(691.5," D ^DIK
S MCCNT=MCCNT+1
W:MCCNT#100=0 "."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM0F 636 printed Nov 22, 2024@17:22:01 Page 2
MCARAM0F ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-MISS TRAN REC ;1/31/95 11:31
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
+4 ;Called from ^MCARAM0
+5 ;Deletes EKG records without transaction by IEN patient match
+6 SET (MCIEN,MCDATE,MCNAME,MCI,MCJ,MCZERO,MCK)=0
+7 FOR
SET MCIEN=$ORDER(^MCAR(691.5,MCIEN))
if MCIEN="B"
QUIT
SET MCDATE=$PIECE(^MCAR(691.5,MCIEN,0),"^")
SET MCSSN=^MCAR(691.5,MCIEN,.1)
DO CHECK
+8 QUIT
CHECK ;
+1 SET MCI=0
FOR
SET MCERR=0
SET MCI=$ORDER(^MCAR(700.5,"B",MCDATE,MCI))
if MCI=""
QUIT
SET MCZERO=^MCAR(700.5,MCI,0)
IF $PIECE(MCZERO,"^",3)=MCSSN
SET MCERR=MCIEN
QUIT
+2 IF MCERR=0
DO DEL
QUIT
+3 QUIT
DEL SET DA=MCIEN
SET DIK="^MCAR(691.5,"
DO ^DIK
+1 SET MCCNT=MCCNT+1
+2 if MCCNT#100=0
WRITE "."
+3 QUIT
