LRMIPLOG ;SLC/CJS/BA - PRINT BY LOG NUMBER ;11/23/12 14:13;
;;5.2;LAB SERVICE;**427**;Sep 27, 1994;Build 33
;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 ;
N LRMLTRPT ;multi report flag for RPT^LRMIPSZ1
S LRMLTRPT=1
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIPLOG 1080 printed Dec 13, 2024@02:17:10 Page 2
LRMIPLOG ;SLC/CJS/BA - PRINT BY LOG NUMBER ;11/23/12 14:13;
+1 ;;5.2;LAB SERVICE;**427**;Sep 27, 1994;Build 33
+2 ;from option LRMIPLOG
BEGIN DO ^LRPARAM
DO LOG
END KILL 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
+1 QUIT
LOG DO LRAA^LRMIUT
if LRAA<1
QUIT
SET LREND=0
SET LRDAT=LRDT0
SET (LRADX,LRONETST,LRONESPC)=""
+1 FOR I=0:0
SET LRAD=$EXTRACT(DT,2,3)
SET %DT=""
SET %DT("A")="Accession Date: "
SET %DT("B")=LRAD
DO DATE^LRWU
if LREND!(Y'<2800000)
QUIT
+2 if LREND
QUIT
+3 SET LRAD=$SELECT($PIECE(^LRO(68,LRAA,0),U,3)="Y":$EXTRACT(Y,1,3)_"0000",1:Y)
+4 WRITE !!,"Enter Accession Numbers"
+5 DO LRAN^LRMIUT
if '$ORDER(LRAN(0))
QUIT
+6 SET %ZIS("B")=""
SET %ZIS="MQ"
SET ZTRTN="DQ^LRMIPLOG"
DO IO^LRWU
+7 QUIT
DQ ;dequeued
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
DO DT^LRX
+2 SET LRAN=0
FOR I=0:0
SET LRAN=+$ORDER(LRAN(LRAN))
if LRAN<1
QUIT
DO SENDUP
if LREND
QUIT
+3 QUIT
SENDUP ;
+1 ;multi report flag for RPT^LRMIPSZ1
NEW LRMLTRPT
+2 SET LRMLTRPT=1
+3 if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
QUIT
SET LRIDT=9999999-^(3)
SET LRDFN=+^(0)
SET LRLLT=^LR(LRDFN,"MI",LRIDT,0)
SET LRACC=$PIECE(LRLLT,U,6)
SET LRCMNT=$SELECT($DATA(^(99)):^(99),1:"")
SET LRPG=0
DO EN^LRMIPSZ1
if LREND
QUIT
+4 QUIT
