LRMINEW2 ;DALOI/STAFF - NEW DATA TO BE REVIEWED/VERIFIED ;Nov 10, 2008
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
Q2 ;
;
N DIR,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="Y",DIR("B")="YES"
S DIR("?")="Answer ""NO"" if you want to look at it now!"
S DIR("?",1)="Answer ""YES"" to queue printing"
S DIR("A")="Do you want to queue the data to print and review/approve it later"
D ^DIR
I $D(DIRUT) Q
I Y=1 S %ZIS="MQ",%ZIS("B")="",IOP="Q"
W ! S ZTRTN="DQ^LRMINEW2" D IO^LRWU
Q
;
;
DQ ;
;
N LRAN,LRLOCA,LRPG
U IO K ^TMP($J) S LREND=0,LRONETST="",LRONESPC=""
S LRAN=0
F S LRAN=+$O(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) Q:LRAN<1!($G(LREND)) D:+^(LRAN)=LRDXZ!(LRDXZ=0) SORT
S LRLOCA="",LRPG=1
F S LRLOCA=$O(^TMP($J,LRLOCA)) Q:LRLOCA=""!($G(LREND)) D
. S LRLTR=$E(LRLOCA,1,4),LRPG=1
. W @IOF I $E(IOST,1,2)'="C-" D ^LRLTR
. S LRAN=0
. F S LRAN=+$O(^TMP($J,LRLOCA,LRAN)) Q:LRAN<1!($G(LREND)) D SENDUP Q:LREND
;
K ^TMP($J),LRWRDVEW
;
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
;
SORT ;
Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LRLOCA=$P(^(0),U,7)
I LRLOCA'="" S ^TMP($J,LRLOCA,LRAN)=""
Q
;
;
SENDUP ;
Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3))!($G(LREND)) S LRIDT=9999999-^(3),LRDFN=+^(0)
S LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRCMNT=$S($D(^(99)):^(99),1:"")
D EN^LRMIPSZ1
I $E(IOST,1,2)'="C-" W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMINEW2 1381 printed Apr 09, 2024@21:14:35 Page 2
LRMINEW2 ;DALOI/STAFF - NEW DATA TO BE REVIEWED/VERIFIED ;Nov 10, 2008
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
Q2 ;
+1 ;
+2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="Y"
SET DIR("B")="YES"
+4 SET DIR("?")="Answer ""NO"" if you want to look at it now!"
+5 SET DIR("?",1)="Answer ""YES"" to queue printing"
+6 SET DIR("A")="Do you want to queue the data to print and review/approve it later"
+7 DO ^DIR
+8 IF $DATA(DIRUT)
QUIT
+9 IF Y=1
SET %ZIS="MQ"
SET %ZIS("B")=""
SET IOP="Q"
+10 WRITE !
SET ZTRTN="DQ^LRMINEW2"
DO IO^LRWU
+11 QUIT
+12 ;
+13 ;
DQ ;
+1 ;
+2 NEW LRAN,LRLOCA,LRPG
+3 USE IO
KILL ^TMP($JOB)
SET LREND=0
SET LRONETST=""
SET LRONESPC=""
+4 SET LRAN=0
+5 FOR
SET LRAN=+$ORDER(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN))
if LRAN<1!($GET(LREND))
QUIT
if +^(LRAN)=LRDXZ!(LRDXZ=0)
DO SORT
+6 SET LRLOCA=""
SET LRPG=1
+7 FOR
SET LRLOCA=$ORDER(^TMP($JOB,LRLOCA))
if LRLOCA=""!($GET(LREND))
QUIT
Begin DoDot:1
+8 SET LRLTR=$EXTRACT(LRLOCA,1,4)
SET LRPG=1
+9 WRITE @IOF
IF $EXTRACT(IOST,1,2)'="C-"
DO ^LRLTR
+10 SET LRAN=0
+11 FOR
SET LRAN=+$ORDER(^TMP($JOB,LRLOCA,LRAN))
if LRAN<1!($GET(LREND))
QUIT
DO SENDUP
if LREND
QUIT
End DoDot:1
+12 ;
+13 KILL ^TMP($JOB),LRWRDVEW
+14 ;
+15 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+16 QUIT
+17 ;
+18 ;
SORT ;
+1 if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
QUIT
SET LRLOCA=$PIECE(^(0),U,7)
+2 IF LRLOCA'=""
SET ^TMP($JOB,LRLOCA,LRAN)=""
+3 QUIT
+4 ;
+5 ;
SENDUP ;
+1 if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3))!($GET(LREND))
QUIT
SET LRIDT=9999999-^(3)
SET LRDFN=+^(0)
+2 SET LRLLT=^LR(LRDFN,"MI",LRIDT,0)
SET LRACC=$PIECE(LRLLT,U,6)
SET LRCMNT=$SELECT($DATA(^(99)):^(99),1:"")
+3 DO EN^LRMIPSZ1
+4 IF $EXTRACT(IOST,1,2)'="C-"
WRITE @IOF
+5 QUIT
