21 lines
976 B
Mathematica
21 lines
976 B
Mathematica
LRMIPLOG ;SLC/CJS/BA - PRINT BY LOG NUMBER ;2/19/91 10:53 ;
|
|
;;5.2;LAB SERVICE;;Sep 27, 1994
|
|
;from option LRMIPLOG
|
|
BEGIN D ^LRPARAM D LOG
|
|
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
|
|
Q
|
|
LOG D LRAA^LRMIUT Q:LRAA<1 S LREND=0 S LRDAT=LRDT0,(LRADX,LRONETST,LRONESPC)=""
|
|
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)
|
|
Q:LREND
|
|
S LRAD=$S($P(^LRO(68,LRAA,0),U,3)="Y":$E(Y,1,3)_"0000",1:Y)
|
|
W !!,"Enter Accession Numbers"
|
|
D LRAN^LRMIUT Q:'$O(LRAN(0))
|
|
S %ZIS("B")="",%ZIS="MQ" S ZTRTN="DQ^LRMIPLOG" D IO^LRWU
|
|
Q
|
|
DQ ;dequeued
|
|
S:$D(ZTQUEUED) ZTREQ="@" U IO D DT^LRX
|
|
S LRAN=0 F I=0:0 S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1 D SENDUP Q:LREND
|
|
Q
|
|
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
|
|
Q
|