MCARAM0D ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-NONDHCP NAME ;1/31/95 11:28
;;2.3;Medicine;;09/13/1996
;
;
; Called from ^MCARAM0
; remove records cross-referenced by non-DHCP name
S (MCIEN,MCNAME,MCSSN,MCI,MCJ,MCK)=0
F S MCI=$O(^MCAR(700.5,"PT",MCI)) Q:MCI="" I MCI["=>"!(MCI["<=") S MCIEN=0 F S MCIEN=$O(^MCAR(700.5,"PT",MCI,MCIEN)) Q:MCIEN="" D DEL
Q
DEL ;
I '$D(^MCAR(700.5,MCIEN,0)) S DIK="^MCAR(700.5,",DA=MCIEN D ^DIK Q
S MCSSN=$P(^MCAR(700.5,MCIEN,0),"^",3),MCDATE=$P(^MCAR(700.5,MCIEN,0),"^")
S MCK=0 S MCK=$O(^MCAR(691.5,"B",MCDATE,MCK)) Q:MCK="" I ^MCAR(691.5,MCK,.1)=MCSSN S DIK="^MCAR(691.5,",DA=MCK D ^DIK
S DIK="^MCAR(700.5,",DA=MCIEN D ^DIK
S MCCNT=MCCNT+1
W:MCCNT#100=0 "."
K MCSSN,MCDATE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM0D 751 printed Nov 22, 2024@17:21:59 Page 2
MCARAM0D ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-NONDHCP NAME ;1/31/95 11:28
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
+4 ; Called from ^MCARAM0
+5 ; remove records cross-referenced by non-DHCP name
+6 SET (MCIEN,MCNAME,MCSSN,MCI,MCJ,MCK)=0
+7 FOR
SET MCI=$ORDER(^MCAR(700.5,"PT",MCI))
if MCI=""
QUIT
IF MCI["=>"!(MCI["<=")
SET MCIEN=0
FOR
SET MCIEN=$ORDER(^MCAR(700.5,"PT",MCI,MCIEN))
if MCIEN=""
QUIT
DO DEL
+8 QUIT
DEL ;
+1 IF '$DATA(^MCAR(700.5,MCIEN,0))
SET DIK="^MCAR(700.5,"
SET DA=MCIEN
DO ^DIK
QUIT
+2 SET MCSSN=$PIECE(^MCAR(700.5,MCIEN,0),"^",3)
SET MCDATE=$PIECE(^MCAR(700.5,MCIEN,0),"^")
+3 SET MCK=0
SET MCK=$ORDER(^MCAR(691.5,"B",MCDATE,MCK))
if MCK=""
QUIT
IF ^MCAR(691.5,MCK,.1)=MCSSN
SET DIK="^MCAR(691.5,"
SET DA=MCK
DO ^DIK
+4 SET DIK="^MCAR(700.5,"
SET DA=MCIEN
DO ^DIK
+5 SET MCCNT=MCCNT+1
+6 if MCCNT#100=0
WRITE "."
+7 KILL MCSSN,MCDATE
+8 QUIT
