MCARAM0E.m

MCARAM0E ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-NOTED REC IN ERR ;1/31/95  11:30

 ;;2.3;Medicine;;09/13/1996

 ;

 ;

 ;Called from ^MCARAM0

 ;Delete automated EKGs that are marked for deletion

 ; and corresponding transaction records

 N MCIEN,MCSTAT,MCTIEN,MCDATE,MCSSN

 S (MCIEN,MCTIEN,MCDATE)=0

 F  S MCIEN=$O(^MCAR(691.5,MCIEN)) Q:MCIEN="B"  I $D(^MCAR(691.5,MCIEN,"A")),$D(^MCAR(691.5,MCIEN,"ES")) S MCSTAT=$P(^MCAR(691.5,MCIEN,"ES"),"^",12) I MCSTAT=1 D DEL

 Q

DEL ;

 S MCTIEN=0

 S MCSSN=^MCAR(691.5,MCIEN,.1)

 S MCDATE=$P(^MCAR(691.5,MCIEN,0),"^")

 F  S MCTIEN=$O(^MCAR(700.5,"B",MCDATE,MCTIEN)) Q:MCTIEN=""  I $P(^MCAR(700.5,MCTIEN,0),"^",3)=MCSSN S DIK="^MCAR(700.5,",DA=MCTIEN D ^DIK S DIK="^MCAR(691.5,",DA=MCIEN D ^DIK S MCCNT=MCCNT+1 W:MCCNT#100=0 "."

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MCARAM0E   785     printed  Apr 09, 2024@21:14:59                                                                                                                                                                                                     Page 2

MCARAM0E  ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-NOTED REC IN ERR ;1/31/95  11:30

 +1       ;;2.3;Medicine;;09/13/1996

 +2       ;

 +3       ;

 +4       ;Called from ^MCARAM0

 +5       ;Delete automated EKGs that are marked for deletion

 +6       ; and corresponding transaction records

 +7        NEW MCIEN,MCSTAT,MCTIEN,MCDATE,MCSSN

 +8        SET (MCIEN,MCTIEN,MCDATE)=0

 +9        FOR 

               SET MCIEN=$ORDER(^MCAR(691.5,MCIEN))

               if MCIEN="B"

                   QUIT 

               IF $DATA(^MCAR(691.5,MCIEN,"A"))

                   IF $DATA(^MCAR(691.5,MCIEN,"ES"))

                       SET MCSTAT=$PIECE(^MCAR(691.5,MCIEN,"ES"),"^",12)

                       IF MCSTAT=1

                           DO DEL

 +10       QUIT 

DEL       ;

 +1        SET MCTIEN=0

 +2        SET MCSSN=^MCAR(691.5,MCIEN,.1)

 +3        SET MCDATE=$PIECE(^MCAR(691.5,MCIEN,0),"^")

 +4        FOR 

               SET MCTIEN=$ORDER(^MCAR(700.5,"B",MCDATE,MCTIEN))

               if MCTIEN=""

                   QUIT 

               IF $PIECE(^MCAR(700.5,MCTIEN,0),"^",3)=MCSSN

                   SET DIK="^MCAR(700.5,"

                   SET DA=MCTIEN

                   DO ^DIK

                   SET DIK="^MCAR(691.5,"

                   SET DA=MCIEN

                   DO ^DIK

                   SET MCCNT=MCCNT+1

                   if MCCNT#100=0

                       WRITE "."

 +5        QUIT