| 1 | LRMIPSZ ;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
|
|---|
| 4 | BEGIN D ^LRPARAM W !!?23,"MICROBIOLOGY SINGLE SPECIMEN REPORT" S LREND=0,LRNL=1,LRPG=0 D CHOOSE
|
|---|
| 5 | 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
|
|---|
| 6 | Q
|
|---|
| 7 | 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)
|
|---|
| 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
|
|---|
| 11 | DQ ;dequeued
|
|---|
| 12 | S:$D(ZTQUEUED) ZTREQ="@" U IO
|
|---|
| 13 | S LRONETST="",LRONESPC="" D EN^LRMIPSZ1 K LRONETST,LRONESPC
|
|---|
| 14 | Q
|
|---|
| 15 | ACC 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
|
|---|
| 18 | 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:"")
|
|---|
| 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
|
|---|
| 23 | PAT 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
|
|---|
| 27 | PAST 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
|
|---|
| 33 | WAIT R !,"PRESS '^' TO STOP ",X:DTIME S:X="" X=1 S LRSTOP=".^"[X
|
|---|
| 34 | Q
|
|---|
| 35 | 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
|
|---|
| 36 | Q
|
|---|
| 37 | SELECT 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
|
|---|
