MCARAM0F.m

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

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