MCARAM0G.m

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 ---MCARAM0G   698     printed  Apr 09, 2024@21:17:07                                                                                                                                                                                                     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