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