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
Q
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
Q
DEL ;
S MCCNT=MCCNT+1
S DIK=MCROOT,DA=MCIEN D ^DIK
W:MCCNT#100=0 "."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM0A 1480 printed Dec 13, 2024@02:11:54 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
