| [613] | 1 | LRAPT1 ;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 | ;
|
|---|
| 13 | H1 ;
|
|---|
| 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 | ;
|
|---|
| 24 | H 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
|
|---|
