[613] | 1 | LRMIPLOG ;SLC/CJS/BA - PRINT BY LOG NUMBER ;2/19/91 10:53 ;
|
---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
---|
| 3 | ;from option LRMIPLOG
|
---|
| 4 | BEGIN D ^LRPARAM D LOG
|
---|
| 5 | END K D,DFN,DIC,DOB,I,J,K,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDAT,LRDFN,LRDPF,LREND,LRIDT,LRLLT,LRONESPC,LRONETST,LRPG,PNM,POP,R,SSN,X,X1,Y
|
---|
| 6 | Q
|
---|
| 7 | LOG D LRAA^LRMIUT Q:LRAA<1 S LREND=0 S LRDAT=LRDT0,(LRADX,LRONETST,LRONESPC)=""
|
---|
| 8 | F I=0:0 S LRAD=$E(DT,2,3),%DT="",%DT("A")="Accession Date: ",%DT("B")=LRAD D DATE^LRWU Q:LREND!(Y'<2800000)
|
---|
| 9 | Q:LREND
|
---|
| 10 | S LRAD=$S($P(^LRO(68,LRAA,0),U,3)="Y":$E(Y,1,3)_"0000",1:Y)
|
---|
| 11 | W !!,"Enter Accession Numbers"
|
---|
| 12 | D LRAN^LRMIUT Q:'$O(LRAN(0))
|
---|
| 13 | S %ZIS("B")="",%ZIS="MQ" S ZTRTN="DQ^LRMIPLOG" D IO^LRWU
|
---|
| 14 | Q
|
---|
| 15 | DQ ;dequeued
|
---|
| 16 | S:$D(ZTQUEUED) ZTREQ="@" U IO D DT^LRX
|
---|
| 17 | S LRAN=0 F I=0:0 S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1 D SENDUP Q:LREND
|
---|
| 18 | Q
|
---|
| 19 | SENDUP Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) S LRIDT=9999999-^(3),LRDFN=+^(0),LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRCMNT=$S($D(^(99)):^(99),1:""),LRPG=0 D EN^LRMIPSZ1 Q:LREND
|
---|
| 20 | Q
|
---|