source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRUPAD.m@ 1608

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1LRUPAD ;AVAMC/REG/WTY - LAB ACCESSION LIST BY DATE ;9/25/00
2 ;;5.2;LAB SERVICE;**72,248**;Sep 27, 1994
3 ;
4 ;Reference to ^%DT supported by IA #10003
5 ;Reference to ^DIC supported by IA #10006
6 ;
7 I '$D(LRAA)!('$D(LRAA(1))) D ^LRUBYDIV G:'$D(Y) END
8 K C S %DT="",X="T" D ^%DT S (Q(1),Q(2),Z(4))=0 D D^LRU,EN^LRUTL S Z(1)=Y
9 S:'$D(LRO(68)) LRO(68)=LRAA(1) W !!?20,LRO(68)," ACCESSION LIST"
10 D B^LRU G:Y<0 END
11 S LRLDT=LRLDT+.99,X=$P(^LRO(68,LRAA,0),U,3),V(1)=$S(X="Y":$E(LRSDT,1,3)_"0000",1:LRSDT),V=$S(X="Y":$E(LRLDT,1,3)_"0000",1:LRLDT)
12L W !!,"List by (A)ccession number (P)atient ",$S("CHMI"[LRSS:"(C)ollection Sample ",1:""),": " R X:DTIME G:X=""!(X[U) END I $A(X)'=65&($A(X)'=67)&($A(X)'=80) D S G L
13 I "AP"'[$E(X)&(X?1"C".E&("CHMI"'[LRSS)) D H G L
14 W:$L(X)=1 $S(X="P":"atient",X="A":"ccession number",1:"ollection Sample") G:X?1"P".E ^LRUPAD2
15 I X?1"C".E S DIC="62",DIC(0)="AEMOQ",DIC("A")="Select COLLECTION SAMPLE: " D ^DIC K DIC G:Y<1 END S C(1)=+Y,C=$P(Y,U,2)
16 S ZTRTN="QUE^LRUPAD" D BEG^LRUTL G:POP!($D(ZTSK)) END
17QUE U IO S LRU(1)=+$O(^LAB(62,"B","UNKNOWN",0)) D L^LRU,S^LRU,H S LR("F")=1
18 S V(1)=V(1)-1
19 F I=V(1):0 S I=$O(^LRO(68,LRAA,1,I)) Q:'I!(I>V)!(LR("Q")) S LRSA=LRSDT-.01 F B=LRSA:0 S B=$O(^LRO(68,LRAA,1,I,1,"E",B)) Q:'B!(B>LRLDT)!(LR("Q")) I $P(B,".")=I!($E(I,6,7)="00") D O
20 I 'LR("Q"),LRSS="CY" D:$Y>(IOSL-8) H Q:LR("Q") W !?72,"-----",!,"Cell block (b) count: ",Q(1),?58,"Slide count:",?72,$J(Q(2),5)
21 W:IOST'?1"C".E&($E(IOST,1,2)'="P-"!($D(LR("FORM")))) @IOF
22 D END^LRUTL,END Q
23O F N=0:0 S N=$O(^LRO(68,LRAA,1,I,1,"E",B,N)) Q:'N!(LR("Q")) S LRC(5)=$S($D(^LRO(68,LRAA,1,I,1,N,3)):$P(^(3),"^",6),1:"") D ^LRUPAD1
24 Q
25H ;from LRUPAD1
26 I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
27 D F^LRU
28 W !,LRO(68)," (",LRSTR,"-",LRLST,")",! W:$D(C)#2 "Collection Sample: ",C,!
29 W "# = Not VA patient ",$S(LRSS="CY":"* = Reviewed by pathologist",1:""),?57,$S("AUSPCYEMMI"[LRSS:"% =Incomplete",1:"")
30 W ?60,$S("CH"[LRSS:"%=Test not verified",1:"") I LRSS="CY" W ?72,"Slide"
31 W !,"Acc #",?8,"Date",?14,$S(LRSS="MI":"Patient/Source",1:"Patient"),?34,"ID",?40,"Loc" W:LRSS'="AU" ?46,$S("SPCYEM"[LRSS:"Physician",1:"Spec/sample") I LRSS="CY" W ?72,"Count"
32 I "CHMI"[LRSS W ?62,"Test",?76,"Tech",!,LR("%") Q
33 W:LRSS="AU" ?46,"Date/time of Autopsy" W !,LR("%") Q
34S W !!,"Enter following letter for appropriate listing:"
35 W !?5,"'A' for listing by accession number"
36 W !?5,"'P' for listing by patient"
37 W:"AUCYEMSP"'[LRSS !?5,"'C' for listing by collection sample"
38 Q
39 ;
40END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.