40 lines
2.3 KiB
Mathematica
40 lines
2.3 KiB
Mathematica
LRMIPSZ ;AVAMC/REG/SLC/CJS/BA - MICRO PRINT/SINGLE SPECIMEN REPORT ;2/19/91 10:55 ;
|
|
;;5.2;LAB SERVICE;**104**;Sep 27, 1994
|
|
;from option LRMIPSZ
|
|
BEGIN D ^LRPARAM W !!?23,"MICROBIOLOGY SINGLE SPECIMEN REPORT" S LREND=0,LRNL=1,LRPG=0 D CHOOSE
|
|
END 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
|
|
Q
|
|
CHOOSE 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)
|
|
Q:X[U S LREP=X S:LREP="" LREP=1
|
|
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
|
|
Q
|
|
DQ ;dequeued
|
|
S:$D(ZTQUEUED) ZTREQ="@" U IO
|
|
S LRONETST="",LRONESPC="" D EN^LRMIPSZ1 K LRONETST,LRONESPC
|
|
Q
|
|
ACC D ^LRMIU4 S:LRAN<1 LREND=1 Q:LREND
|
|
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
|
|
Q
|
|
ACC1 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:"")
|
|
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !?20,PNM,?40,SSN
|
|
F W !,?20,"OK" S %=1 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
|
|
S:%=-1 LREND=1 S:%=2 LRANOK=0
|
|
Q
|
|
PAT D ^LRDPA S:LRDFN=-1 LREND=1 Q:LREND
|
|
D PAST S:'$D(LRLLT) LREND=1 Q:LREND
|
|
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
|
|
Q
|
|
PAST W ! K LRAN
|
|
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
|
|
I LRCNT=1 W !,"Nothing accessioned" K LRLLT Q
|
|
S:LRCNT=2 LRIDT=LRLIDT I LRCNT'=2 D SELECT Q:X=""!(X[U)
|
|
S LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRCMNT=$S($D(^(99)):^(99),1:"")
|
|
Q
|
|
WAIT R !,"PRESS '^' TO STOP ",X:DTIME S:X="" X=1 S LRSTOP=".^"[X
|
|
Q
|
|
PAST1 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
|
|
Q
|
|
SELECT K LRLLT S LRSTOP=0 F R !!,"Select #: ",X:DTIME Q:X=""!(X[U) Q:$D(LRAN(X)) W !,"Doesn't exist."
|
|
I X'="",X'[U S LRIDT=LRAN(X)
|
|
Q
|