- 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 Jan 18, 2025@03:13:10 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