source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCARAM0D.m@ 846

Last change on this file since 846 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 733 bytes
RevLine 
[613]1MCARAM0D ;WASH ISC/JKL-MUSE AUTO INSTRUMENT REINIT-NONDHCP NAME ;1/31/95 11:28
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 ;
5 ; Called from ^MCARAM0
6 ; remove records cross-referenced by non-DHCP name
7 S (MCIEN,MCNAME,MCSSN,MCI,MCJ,MCK)=0
8 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
9 Q
10DEL ;
11 I '$D(^MCAR(700.5,MCIEN,0)) S DIK="^MCAR(700.5,",DA=MCIEN D ^DIK Q
12 S MCSSN=$P(^MCAR(700.5,MCIEN,0),"^",3),MCDATE=$P(^MCAR(700.5,MCIEN,0),"^")
13 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
14 S DIK="^MCAR(700.5,",DA=MCIEN D ^DIK
15 S MCCNT=MCCNT+1
16 W:MCCNT#100=0 "."
17 K MCSSN,MCDATE
18 Q
Note: See TracBrowser for help on using the repository browser.