source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPT1.m@ 1006

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

initial load of WorldVistAEHR

File size: 872 bytes
Line 
1LRAPT1 ;AVAMC/REG/WTY - ANATOMIC PATH PRINT ;10/16/01
2 ;;5.2;LAB SERVICE;**72,173,259**;Sep 27, 1994
3 S LRSF515=+$G(LRSF515) ;Indicates an SF515 is being generated
4 I LRSF515 D:$Y>(IOSL-13) F^LRAPF,^LRAPF
5 I 'LRSF515 D H S LR("F")=1
6 Q:LR("Q")
7 F S="SP","CY","EM" Q:LR("Q") D
8 .D H1 Q:LR("Q")
9 .S LRI=0
10 .F S LRI=$O(^LR(LRDFN,S,LRI)) Q:'LRI!(LR("Q")) D EN^LRAPPF1
11 Q
12 ;
13H1 ;
14 N LRTMP
15 Q:'$O(^LR(LRDFN,S,0))
16 I LRSF515 D:$Y>(IOSL-13) F^LRAPF,^LRAPF
17 I 'LRSF515 D:$Y>(IOSL-14) H
18 Q:LR("Q")
19 S LRTMP=$S(S="SP":"SURGICAL PATHOLOGY",S="CY":"CYTOPATHOLOGY",1:"")
20 S:LRTMP="" LRTMP=$S(S="EM":"ELECTRON MICROSCOPY",1:"")
21 W !!,?30,LRTMP
22 Q
23 ;
24H I $D(LR("F")),$E(IOST,1,2)["C-" D M^LRU Q:LR("Q")
25 D F^LRU W !,"ANATOMIC PATHOLOGY"
26 I $D(LR("W")) D
27 .W !,$S($D(LRO(68)):LRO(68),1:LRAA(1))," QA from ",LRSTR
28 .W " to ",LRLST
29 W !,LR("%")
30 W !,LRP,?32,"SSN:",SSN,?48,"DOB:",DOB
31 Q
Note: See TracBrowser for help on using the repository browser.