source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCPOS06.m@ 837

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

initial load of WorldVistAEHR

File size: 607 bytes
RevLine 
[613]1MCPOS06 ;HIRMFO/DAD-FIX SUBDD NUMBER IN DATA NODES ;4/25/96 10:55
2 ;;2.3;Medicine;;09/13/1996
3 ;
4 ; Change subDD number to 699.501
5 N MCD0,MCDATA,MCSUBDD
6 S MCDATA(1)=""
7 S MCDATA(2)="Checking the sub-DD numbers in the Generalized"
8 S MCDATA(3)="Procedure/Consult file (#699.5)."
9 D MES^XPDUTL(.MCDATA)
10 ;
11 S MCD0=0
12 F S MCD0=$O(^MCAR(699.5,MCD0)) Q:MCD0'>0 D
13 . S MCDATA=$G(^MCAR(699.5,MCD0,2,0))
14 . I MCDATA="",$O(^MCAR(699.5,MCD0,2,0))'>0 Q
15 . S MCSUBDD=$P(MCDATA,U,2)
16 . I +MCSUBDD'=699.501 D
17 .. S $P(MCDATA,U,2)="699.501"_$TR(MCSUBDD,"1234567890.")
18 .. S ^MCAR(699.5,MCD0,2,0)=MCDATA
19 .. Q
20 . Q
21 Q
Note: See TracBrowser for help on using the repository browser.