Routine: MCARAM0A

MCARAM0A ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-EXT DATE ;2/24/95  10:39

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

 ;Called from ^MCARAM0

 ;Deletes corruption of records filed with external dates

 N MCLD,MCJ,MCNAM,MCDATE,MCIEN,MCPID,MCDT,DA,DIK

 S MCLD=9999999

 F I=1:1 S MCLD=$O(^MCAR(691.5,"B",MCLD)) Q:MCLD="ES"!(MCLD="")  S MCNAME="",MCSSN="",MCPID="",MCDT=MCLD,MCERR="",MCTR="" D CHECK

 ; deletes extraneous cross-reference on zero node

 I $D(^MCAR(691.5,0,"ES")) K ^MCAR(691.5,0,"ES")

 ; deletes extraneous cross-reference on "B" node

 I $D(^MCAR(691.5,"B","ES")) K ^MCAR(691.5,"B","ES")

 ; deletes extraneous cross-reference of EKG file

 ; checks for matching cross-references of record

 S (MCDATE,MCIEN)=0

 F  S MCDATE=$O(^MCAR(691.5,"B",MCDATE)) Q:MCDATE=""  S MCIEN=0 F  S MCIEN=$O(^MCAR(691.5,"B",MCDATE,MCIEN)) Q:MCIEN=""  I '$D(^MCAR(691.5,MCIEN)) K ^MCAR(691.5,"B",MCDATE,MCIEN)

 S (MCPID,MCIEN)=0

 F  S MCPID=$O(^MCAR(691.5,"C",MCPID)) Q:MCPID=""  S MCIEN=0 F  S MCIEN=$O(^MCAR(691.5,"C",MCPID,MCIEN)) Q:MCIEN=""  I '$D(^MCAR(691.5,MCIEN)) K ^MCAR(691.5,"C",MCPID,MCIEN)

 K MCLD,MCJ,MCNAM,MCDATE,MCIEN,MCPID,MCDT,DA,DIK

CHECK ;

 S %DT="T",X=MCLD D ^%DT S MCDT=Y

 S MCJ=0 F  S MCJ=$O(^MCAR(691.5,"B",MCDT,MCJ)) Q:MCJ=""  S MCIEN=MCJ,MCROOT="^MCAR(691.5," D DEL

 S MCJ=0 F  S MCJ=$O(^MCAR(700.5,"B",MCDT,MCJ)) Q:MCJ=""  S MCIEN=MCJ,MCROOT="^MCAR(700.5," D DEL

DEL ;

 S MCCNT=MCCNT+1

 S DIK=MCROOT,DA=MCIEN D ^DIK

 W:MCCNT#100=0 "."

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM0A   1480     printed  Apr 09, 2024@21:15:25                                                                                                                                                                                                    Page 2

MCARAM0A  ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-EXT DATE ;2/24/95  10:39

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

 +2       ;

 +3       ;

 +4       ;Called from ^MCARAM0

 +5       ;Deletes corruption of records filed with external dates

 +6        NEW MCLD,MCJ,MCNAM,MCDATE,MCIEN,MCPID,MCDT,DA,DIK

 +7        SET MCLD=9999999

 +8        FOR I=1:1

               SET MCLD=$ORDER(^MCAR(691.5,"B",MCLD))

               if MCLD="ES"!(MCLD="")

                   QUIT

               SET MCNAME=""

               SET MCSSN=""

               SET MCPID=""

               SET MCDT=MCLD

               SET MCERR=""

               SET MCTR=""

               DO CHECK

 +9       ; deletes extraneous cross-reference on zero node

 +10       IF $DATA(^MCAR(691.5,0,"ES"))

               KILL ^MCAR(691.5,0,"ES")

 +11      ; deletes extraneous cross-reference on "B" node

 +12       IF $DATA(^MCAR(691.5,"B","ES"))

               KILL ^MCAR(691.5,"B","ES")

 +13      ; deletes extraneous cross-reference of EKG file

 +14      ; checks for matching cross-references of record

 +15       SET (MCDATE,MCIEN)=0

 +16       FOR

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

               if MCDATE=""

                   QUIT

               SET MCIEN=0

FOR

                   SET MCIEN=$ORDER(^MCAR(691.5,"B",MCDATE,MCIEN))

                   if MCIEN=""

                       QUIT

                   IF '$DATA(^MCAR(691.5,MCIEN))

                       KILL ^MCAR(691.5,"B",MCDATE,MCIEN)

 +17       SET (MCPID,MCIEN)=0

 +18       FOR

               SET MCPID=$ORDER(^MCAR(691.5,"C",MCPID))

               if MCPID=""

                   QUIT

               SET MCIEN=0

FOR

                   SET MCIEN=$ORDER(^MCAR(691.5,"C",MCPID,MCIEN))

                   if MCIEN=""

                       QUIT

                   IF '$DATA(^MCAR(691.5,MCIEN))

                       KILL ^MCAR(691.5,"C",MCPID,MCIEN)

 +19       KILL MCLD,MCJ,MCNAM,MCDATE,MCIEN,MCPID,MCDT,DA,DIK

 +20       QUIT

CHECK     ;

 +1        SET %DT="T"

           SET X=MCLD

           DO ^%DT

           SET MCDT=Y

 +2        SET MCJ=0

FOR

               SET MCJ=$ORDER(^MCAR(691.5,"B",MCDT,MCJ))

               if MCJ=""

                   QUIT

               SET MCIEN=MCJ

               SET MCROOT="^MCAR(691.5,"

               DO DEL

 +3        SET MCJ=0

FOR

               SET MCJ=$ORDER(^MCAR(700.5,"B",MCDT,MCJ))

               if MCJ=""

                   QUIT

               SET MCIEN=MCJ

               SET MCROOT="^MCAR(700.5,"

               DO DEL

 +4        QUIT

DEL       ;

 +1        SET MCCNT=MCCNT+1

 +2        SET DIK=MCROOT

           SET DA=MCIEN

           DO ^DIK

 +3        if MCCNT#100=0

               WRITE "."

 +4        QUIT

MCARAM0A.m