MCARAM0D.m

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

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