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