LRPHEXPT ;SLC/CJS/RWF-EXCEPTION LOGIN OF ACCESSIONS ;8/11/97 [ 04/14/2003 12:01 PM ]
;;5.2T9;LR;**1001,1003,1018**;Nov 17, 2004
;;5.2;LAB SERVICE;**43,121,221**;Sep 27, 1994
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
S:$G(BLROPT)=""!($G(BLROPT(0))'=$P(XQY0,U)) BLROPT="RECCOL",BLROPT(0)=$P(XQY0,U) ;IHS/DIR TUC/AAB 04/17/98
;----- END IHS MODIFICATIONS
S X="N",%DT="T" D ^%DT S LRODT=DT,LRNT=Y
LR1 ;
D ^LRPARAM QUIT:$G(LREND) ;-> 4/25/95 LJA
;
D FNDLOC^LRDRAW G END:LRLLOC["^" I LRLLOC=""&'$D(^XUSEC("LRPHSUPER",DUZ)) W !,"You don't have the LRPHSUPER key to enter 'ALL'." G LRPHEXPT
I LRLLOC="" W !,"You're doing the entire collection" S %=2 D YN^DICN W:%=0 !,"Maybe you'd better think about it some more." G END:%'=1
K LRSN,LROR,LRCOM,LRTCOM,LRNOCOM W !,"Enter Order Numbers not collected: "
LOOP S LRFIRST=1,LROR=0 D
. D LP1^LRPHITEM
I $O(LROR(0))>0 W !,"Let's handle the exceptions first.",! D
. N LRLLOC,LRODT
. S LROR=0 F S LROR=$O(LROR(LROR)) Q:LROR<1 D EXCEPT^LRPHITE3 W ! D EQUALS^LRX W !
W !!,"Now enter any orders that are not canceled but you don't want ""collected"", yet.",!,"If all remaining orders are collected, skip this entry."
W !,"Any order #'s entered here will remain on collection list until 12 midnight.",!,"The orders will not 'rollover' to the next days collection list."
K LROR S LROR=0,LRNOCOM=1 D
. D LP1^LRPHITEM
S %=2 W !!,"Ready to accept the rest of the orders" D YN^DICN G END:%'=1
D INV G:LRLLOC'="" E1 S LRLLOC="" F S LRLLOC=$O(^LRO(69,LRODT,1,"AC",LRLLOC)) Q:LRLLOC="" D E2
G LR1
Q
E1 D E2 G LR1
E2 S LRSN=0 F S LRSN=$O(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)) Q:LRSN="" D
. I ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)=1 I $S($D(^LRO(69,LRODT,1,LRSN,.1)):'$D(LROR(^(.1))),1:1) D P15^LRPHITEM W:$P(^LRO(69,LRODT,1,LRSN,1),U,4)="C" !,LRLLOC," ",$S($D(^(.1)):^(.1),1:".")
Q
INV K ^TMP($J) S %X="LROR(",%Y="^TMP($J," D %XY^%RCR K LROR F I=1:1 Q:'$D(^TMP($J,I)) S LROR(^(I))=""
Q
% R %:DTIME Q:%=""!(%["N")!(%["Y") W !,"Answer 'Y' or 'N': " G %
END K %,A,J1,K,LRFIRST,LRFORD,LRLLOC,LRNOCOM,LRNT,LRODT,LROR,LRSN,X,Y,Z,DIC,LRLLOC,LRAA,LRAD,LRAN,LRDFN,LRSS,LRIDT,LROID,T,LRSN,I,%H,%X,%Y,DIWL,DIWR,DO,DPF,LRBED,LRCS,LRCSN,LRCSS,LRDC,LRDTO,LRFLOG,LRIOZERO,LRIX,LRLWC,LRM,LRORDR,LRORDTIM
K LRGCOM,LROUTINE,LRPR,LRRND,LRSSX,LRSTIK,LRTSN,LRUNQ,LRUR,LRWD,LRWPC,POP Q
LRPHEXPT ;SLC/CJS/RWF-EXCEPTION LOGIN OF ACCESSIONS ;8/11/97 [ 04/14/2003 12:01 PM ]
+1 ;;5.2T9;LR;**1001,1003,1018**;Nov 17, 2004
+2 ;;5.2;LAB SERVICE;**43,121,221**;Sep 27, 1994
+3 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+4 ;IHS/DIR TUC/AAB 04/17/98
IF $GET(BLROPT)=""!($GET(BLROPT(0))'=$PIECE(XQY0,U))
SET BLROPT="RECCOL"
SET BLROPT(0)=$PIECE(XQY0,U)
+5 ;----- END IHS MODIFICATIONS
+6 SET X="N"
SET %DT="T"
DO ^%DT
SET LRODT=DT
SET LRNT=Y
LR1 ;
+1 ;-> 4/25/95 LJA
DO ^LRPARAM
IF $GET(LREND)
QUIT
+2 ;
+3 DO FNDLOC^LRDRAW
IF LRLLOC["^"
GOTO END
IF LRLLOC=""&'$DATA(^XUSEC("LRPHSUPER",DUZ))
WRITE !,"You don't have the LRPHSUPER key to enter 'ALL'."
GOTO LRPHEXPT
+4 IF LRLLOC=""
WRITE !,"You're doing the entire collection"
SET %=2
DO YN^DICN
IF %=0
WRITE !,"Maybe you'd better think about it some more."
IF %'=1
GOTO END
+5 KILL LRSN,LROR,LRCOM,LRTCOM,LRNOCOM
WRITE !,"Enter Order Numbers not collected: "
LOOP SET LRFIRST=1
SET LROR=0
Begin DoDot:1
+1 DO LP1^LRPHITEM
End DoDot:1
+2 IF $ORDER(LROR(0))>0
WRITE !,"Let's handle the exceptions first.",!
Begin DoDot:1
+3 NEW LRLLOC,LRODT
+4 SET LROR=0
FOR
SET LROR=$ORDER(LROR(LROR))
IF LROR<1
QUIT
DO EXCEPT^LRPHITE3
WRITE !
DO EQUALS^LRX
WRITE !
End DoDot:1
+5 WRITE !!,"Now enter any orders that are not canceled but you don't want ""collected"", yet.",!,"If all remaining orders are collected, skip this entry."
+6 WRITE !,"Any order #'s entered here will remain on collection list until 12 midnight.",!,"The orders will not 'rollover' to the next days collection list."
+7 KILL LROR
SET LROR=0
SET LRNOCOM=1
Begin DoDot:1
+8 DO LP1^LRPHITEM
End DoDot:1
+9 SET %=2
WRITE !!,"Ready to accept the rest of the orders"
DO YN^DICN
IF %'=1
GOTO END
+10 DO INV
IF LRLLOC'=""
GOTO E1
SET LRLLOC=""
FOR
SET LRLLOC=$ORDER(^LRO(69,LRODT,1,"AC",LRLLOC))
IF LRLLOC=""
QUIT
DO E2
+11 GOTO LR1
+12 QUIT
E1 DO E2
GOTO LR1
E2 SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,LRODT,1,"AC",LRLLOC,LRSN))
IF LRSN=""
QUIT
Begin DoDot:1
+1 IF ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)=1
IF $SELECT($DATA(^LRO(69,LRODT,1,LRSN,.1)):'$DATA(LROR(^(.1))),1:1)
DO P15^LRPHITEM
IF $PIECE(^LRO(69,LRODT,1,LRSN,1),U,4)="C"
WRITE !,LRLLOC," ",$SELECT($DATA(^(.1)):^(.1),1:".")
End DoDot:1
+2 QUIT
INV KILL ^TMP($JOB)
SET %X="LROR("
SET %Y="^TMP($J,"
DO %XY^%RCR
KILL LROR
FOR I=1:1
IF '$DATA(^TMP($JOB,I))
QUIT
SET LROR(^(I))=""
+1 QUIT
% READ %:DTIME
IF %=""!(%["N")!(%["Y")
QUIT
WRITE !,"Answer 'Y' or 'N': "
GOTO %
END KILL %,A,J1,K,LRFIRST,LRFORD,LRLLOC,LRNOCOM,LRNT,LRODT,LROR,LRSN,X,Y,Z,DIC,LRLLOC,LRAA,LRAD,LRAN,LRDFN,LRSS,LRIDT,LROID,T,LRSN,I,%H,%X,%Y,DIWL,DIWR,DO,DPF,LRBED,LRCS,LRCSN,LRCSS,LRDC,LRDTO,LRFLOG,LRIOZERO,LRIX,LRLWC,LRM,LRORDR,LRORDTIM
+1 KILL LRGCOM,LROUTINE,LRPR,LRRND,LRSSX,LRSTIK,LRTSN,LRUNQ,LRUR,LRWD,LRWPC,POP
QUIT
