source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUSNOM.m@ 1801

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

initial load of WorldVistAEHR

File size: 964 bytes
RevLine 
[613]1LRUSNOM ;AVAMC/REG - ANATOMIC PATH REFERENCES ;4/12/94 10:15 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3A G:'$D(LRF) END K LR("CK") W ! S (DIE,DIC)=LRF,DIC(0)="AEQM" D ^DIC K DIC G:Y<1 END S DA=+Y I DR=5 D CK^LRU G:$D(LR("CK")) A D ^DIE D FRE^LRU G A
4 D PRT G A
5 ;
6DE D END S LRF="^LAB(61.4," G E ;edit Disease
7EE D END S LRF="^LAB(61.2," G E ;edit Etiology
8FE D END S LRF="^LAB(61.3," G E ;edit edit Function
9ME D END S LRF="^LAB(61.1," G E ;edit edit Morphology
10OE D END S LRF="^LAB(61.6," G E ;edit Occupation
11TE D END S LRF="^LAB(61," G E ;edit Topography
12PE D END S LRF="^LAB(61.5," G E ;edit Procedure
13E S DR=5 G LRUSNOM
14 ;
15DP D END S LRF=61.4 G P
16EP D END S LRF=61.2 G P
17FP D END S LRF=61.3 G P
18MP D END S LRF=61.1 G P
19OP D END S LRF=61.6 G P
20TP D END S LRF=61 G P
21PP D END S LRF=61.5 G P
22P S DR="0;JR" G LRUSNOM
23 ;
24PRT ;print references
25 S ZTRTN="QUE^LRUSNOM" D BEG^LRUTL G:POP!($D(ZTSK)) END
26QUE U IO S DIC=^DIC(LRF,0,"GL") D EN^DIQ,END^LRUTL Q
27 ;
28END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.