source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPF.m@ 738

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

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1LRAPF ;AVAMC/REG/WTY - CY/EM/SP RPT ;9/25/00
2 ;;5.2;LAB SERVICE;**173,201,248,259**;Sep 27, 1994
3 ;
4 ;23-MAR-01;WTY;Trimmed down DX in line tag F per SAM-0301-22193
5 ;
6 ;from LRSPRPT,LRSPRPT1, LRSPRPT2, LRSPRPTM
7 I $D(LR("F")),IOST?1"C".E D Q:LR("Q")
8 .K DIR S DIR(0)="E"
9 .D ^DIR W !
10 .S:$D(DTOUT)!(X[U) LR("Q")=1
11 W:($D(LR("F"))) @IOF
12 S LRQ=LRQ+1
13 W !
14 D W
15 W !?5,"MEDICAL RECORD |",?40,LRAA(1),?73,"Pg ",LRQ
16 D:LRQ>1 P
17 D W
18 Q
19F ;from LRSPRPT,LRSPRPT1, LRSPRPT2, LRSPRPTM
20 Q:LR("Q")
21 I IOSL'>66 F Q:$Y>(IOSL-14) W !
22 D W W !,$S('$D(LR("W")):"",1:"See signed copy in chart")
23 W ?57,"(",$S($D(LRO):"End of report",1:"See next page"),")"
24 W !,$G(LRPMD),?52,LRW(9),?55,"| Date ",$G(LRRC)
25 D W
26 W !,LRP,?50,$S('$D(LR("W")):"STANDARD FORM 515",1:"WORK COPY ONLY !!")
27 W !,"ID:",SSN,?16,"SEX:",SEX," DOB:",DOB
28 W:AGE $S($G(VADM(6))]"":" AGE AT DEATH: ",1:" AGE: "),AGE
29 W " LOC:",$E(LRLLOC,1,20)
30 W ! W:$L(LRADM) "ADM:",$P(LRADM,"@")
31 W:$L(LRADX) ?17,"DX:",$E(LRADX,1,26)
32 W ?46,"PCP: "
33 W:LRPRAC ?51,$E(LRPRAC(1),1,28)
34 Q
35P D:LRQ>1 W
36 S ADESC="Accession No. "_$S(LRQ(8)]"":LRQ(8)_LRW(1)_" "_LRAC,1:LRAC)
37 S LENG1=$L(LRQ(1)),LENG2=$L(ADESC),LNSPCE=IOM-LENG2-14
38 S:LENG1>LNSPCE LRQ(1)=$E(LRQ(1),1,LNSPCE)
39 W !?30,"PATHOLOGY REPORT"
40 W !,"Laboratory: ",LRQ(1)
41 W ?(IOM-LENG2-1),ADESC
42 K ADESC,LENG1,LENG2,LNSPCE
43 Q
44W W !,LR("%")
45 Q
Note: See TracBrowser for help on using the repository browser.