source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRMIPSZ.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1LRMIPSZ ;AVAMC/REG/SLC/CJS/BA - MICRO PRINT/SINGLE SPECIMEN REPORT ;2/19/91 10:55 ;
2 ;;5.2;LAB SERVICE;**104**;Sep 27, 1994
3 ;from option LRMIPSZ
4BEGIN D ^LRPARAM W !!?23,"MICROBIOLOGY SINGLE SPECIMEN REPORT" S LREND=0,LRNL=1,LRPG=0 D CHOOSE
5END K ^TMP("LR",$J),%,AGE,DFN,DIC,DOB,I,J,K,LRAA,LRACC,LRAD,LRAN,LRANOK,LRCMNT,LRCNT,LRDFN,LRDPF,LREND,LREP,LRIDT,LRLIDT,LRLLT,LRNL,LRONESPC,LRONETST,LRPG,LRSMP,LRSTOP,PNM,SSN,X,Y
6 Q
7CHOOSE F W !,"1 Look-up by Accession number",!,"2 Look-up by name/ssn",!," Choose: 1// " R X:DTIME S:X="" X=1 Q:"12"[X&(X?1N)!(X[U)
8 Q:X[U S LREP=X S:LREP="" LREP=1
9 S %ZIS="MQ" F K LRAN,DIC D @$S(LREP=1:"ACC",1:"PAT") Q:LREND S ZTRTN="DQ^LRMIPSZ" D IO^LRWU Q:LREND
10 Q
11DQ ;dequeued
12 S:$D(ZTQUEUED) ZTREQ="@" U IO
13 S LRONETST="",LRONESPC="" D EN^LRMIPSZ1 K LRONETST,LRONESPC
14 Q
15ACC D ^LRMIU4 S:LRAN<1 LREND=1 Q:LREND
16 S X=LRAN F R:'$D(LRAN) !!,"Accession #: ",X:DTIME S:X=""!(X[U) LREND=1 Q:LREND S LRANOK=1,LRPG=0 D LRANX^LRMIU4 D:LRANOK ACC1 Q:LREND!LRANOK W !,"Enter the accession number" K LRAN
17 Q
18ACC1 S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRIDT=$P(^(3),U,5),LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRCMNT=$S($D(^LR(LRDFN,"MI",LRIDT,99)):^(99),1:"")
19 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !?20,PNM,?40,SSN
20 F W !,?20,"OK" S %=1 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
21 S:%=-1 LREND=1 S:%=2 LRANOK=0
22 Q
23PAT D ^LRDPA S:LRDFN=-1 LREND=1 Q:LREND
24 D PAST S:'$D(LRLLT) LREND=1 Q:LREND
25 S LRAN=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRAN,U,6),LRAD=$E(LRAN)_$P(LRACC," ",2)_"0000",LRAN=+$P(LRACC," ",3),X=$P(LRACC," "),DIC=68,DIC(0)="M" D ^DIC S:Y<1 LREND=1 Q:LREND S LRAA=+Y
26 Q
27PAST W ! K LRAN
28 S (LRSTOP,LRIDT)=0 F LRCNT=1:1 S LRIDT=+$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1 D:'(LRCNT#5) WAIT Q:LRSTOP D PAST1
29 I LRCNT=1 W !,"Nothing accessioned" K LRLLT Q
30 S:LRCNT=2 LRIDT=LRLIDT I LRCNT'=2 D SELECT Q:X=""!(X[U)
31 S LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRCMNT=$S($D(^(99)):^(99),1:"")
32 Q
33WAIT R !,"PRESS '^' TO STOP ",X:DTIME S:X="" X=1 S LRSTOP=".^"[X
34 Q
35PAST1 S LRAN=$P(^LR(LRDFN,"MI",LRIDT,0),U,6),LRAN(LRCNT)=LRIDT,LRLIDT=LRIDT W !?13,LRCNT S Y=$P(^(0),U),LRSMP=$P(^(0),U,5) D D^LRU W ?20,Y," " W:LRSMP ?41,$P(^LAB(61,LRSMP,0),U),?60,"Acc ",LRAN
36 Q
37SELECT K LRLLT S LRSTOP=0 F R !!,"Select #: ",X:DTIME Q:X=""!(X[U) Q:$D(LRAN(X)) W !,"Doesn't exist."
38 I X'="",X'[U S LRIDT=LRAN(X)
39 Q
Note: See TracBrowser for help on using the repository browser.