LRFASTS ;DALOI/FHS - ENHANCED LRFAST RTN ACCESSION/VERIFY PROCESS ; Jun 3, 2003
;;5.2;LAB SERVICE;**30,95,121,271,286**;Sep 27, 1994
EN ;
N DIC,DIR,DIRUT,DTOUT,DUOUT,LRPER,X,Y
D ^LRPARAM
S LRFASTS=""
I '$D(LRLABKY) W !!?10,"Not authorized to use this option " Q
S LRCW=8,LREND=0,LRPANEL=0
S DIR(0)="YO",DIR("A")="Do you want to review the data before and after you edit",DIR("B")="YES"
D ^DIR
I $D(DIRUT) D QUIT Q
I Y=0 S LRPER=""
S X=$$SELPL^LRVERA(DUZ(2))
I X<1 D QUIT Q
I X'=DUZ(2) N LRPL S LRPL=X
;
K LRCDEF0,LRCDEF
D ^LRORD
;
QUIT ;
I $D(LRCSQ),'$O(^TMP("LRCAP",LRCSQ,DUZ,0)) K ^TMP("LRCAP",LRCSQ,DUZ),LRCSQ
I $D(LRCSQ),$P(LRPARAM,U,14) D STD^LRCAPV K LRIDIV
;
K I12,LRCDEF,LRCDEF0,LRCDEF0X,LRCSQ,LRCW,LRFASTS,LRNTN,LRNX,LRPANEL,LRSSCX,LRDUF0,LRTEC,LRVF,LRXDP,X9,%,L1,LRAD,LREND,LRSN,QUOUT
K LRAL,LRALL,LRCAPMS,LRMA,SEX,S2,T1,AGE,N,D0,D1,DOB,I,LRFASTS,LRSLOW,DIR,X3,LRORDXS,LRADXS,LRSNXS,LRWP,LRWPC
K LRALERT,LRCSQQ,LRT,LRNOW,LRODTSV,LRSNSV,LRSUF0,LRTSNV,NOW,LRI,LRTNSV
; ORVP,ORIFN Killed for OE/RR 2.5
K ORVP,ORIFN
;
D SLOWK,^%ZISC
;
Q
;
;
LRWU4 ;
N L,LRI,LRADXS,LRSNXS
Q:'$G(LRORD)
S LRORDXS=LRORD,LRADXS=0
F S LRADXS=$O(^LRO(69,"C",LRORDXS,LRADXS)) Q:LRADXS<1 D
. S LRSNXS=0
. F S LRSNXS=$O(^LRO(69,"C",LRORDXS,LRADXS,LRSNXS)) Q:LRSNXS<1 D
. . K LRSLOW
. . S LRSN=+LRSNXS,LRAD=+LRADXS,LRORD=+LRORDXS
. . Q:'LRSN!('LRAD)!('$O(^LRO(69,LRAD,1,LRSN,2,0)))
. . S LRI=0
. . F S LRI=$O(^LRO(69,LRAD,1,LRSN,2,LRI)) Q:LRI<1 D
. . . S L=$G(^LRO(69,LRAD,1,LRSN,2,LRI,0))
. . . I $P(L,U,3),$P(L,U,4),$P(L,U,5) S LRSLOW($P(L,U,3,5))=""
. . S LRI=""
. . F S LRI=$O(LRSLOW(LRI)) Q:LRI="" D GO
;
D SLOWK
Q
;
;
GO ;
; Protect variables
N LRAA,LRAD,LRAN,LRADXS,LRSNXS
S LRAD=$P(LRI,U,1),LRAA=$P(LRI,U,2),LRAN=$P(LRI,U,3)
;
; Protect subscript variable
N LRI
;
I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV Q:$G(LREND)
;
; Check for different performing lab.
I $G(LRPL) N LRDUZ S LRDUZ(2)=LRPL
;
D SLOW^LRVER
Q
;
;
SLOWK ;
K I5,LRCSN,LRORIFN,LRWPC,X4
K K,LRACN,LRACN0,LRDAX,LRDOC,LRCDEF,LRCDEF0
K LRLBL,LRLBLBP,LRLL,LRLWC,LRMACH,LROD0,LROD1,LROD3,LROOS,LRORD,LROSD,LRYR
K LRAA,LRACD,LRAN,LRAOD,LRCAPLOC,LRAOD,LRCDT,LRCFL,LRCODEN,LRCS,LRDAT,LRDEL,LRDFN,LRDPF,LRDV,LRDVF,LREAL,LREDO,LRFFLG,LRFP,LRIDIV,LRIDT,LRIX,LRJ,LRK,LRBLBP,LRLCT,LRLDT,LRLLOC,LRM,LRMAX1
K LRMAX2,LRMAXX,LRMETH,LRMX,LRNAME,LRNOCODE,LROLLOC,LROT,LRPR,LRPRAC,LRRB,LRSAMP,LRSAVE,LRSPN,LRSS,LRSSX,LRST,LRSUB,LRSUM,LRSX,LRSXN,LRTEST,LRTN,LRTREA,LRTS,LRTX,LRTY,LRVRM,LRWL0,LRWLC,LRWRD,LRX,LRXD,LRWRD,SSN
K DR,GLB,H8,L,S5,T,TT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRFASTS 2654 printed Oct 16, 2024@18:15:32 Page 2
LRFASTS ;DALOI/FHS - ENHANCED LRFAST RTN ACCESSION/VERIFY PROCESS ; Jun 3, 2003
+1 ;;5.2;LAB SERVICE;**30,95,121,271,286**;Sep 27, 1994
EN ;
+1 NEW DIC,DIR,DIRUT,DTOUT,DUOUT,LRPER,X,Y
+2 DO ^LRPARAM
+3 SET LRFASTS=""
+4 IF '$DATA(LRLABKY)
WRITE !!?10,"Not authorized to use this option "
QUIT
+5 SET LRCW=8
SET LREND=0
SET LRPANEL=0
+6 SET DIR(0)="YO"
SET DIR("A")="Do you want to review the data before and after you edit"
SET DIR("B")="YES"
+7 DO ^DIR
+8 IF $DATA(DIRUT)
DO QUIT
QUIT
+9 IF Y=0
SET LRPER=""
+10 SET X=$$SELPL^LRVERA(DUZ(2))
+11 IF X<1
DO QUIT
QUIT
+12 IF X'=DUZ(2)
NEW LRPL
SET LRPL=X
+13 ;
+14 KILL LRCDEF0,LRCDEF
+15 DO ^LRORD
+16 ;
QUIT ;
+1 IF $DATA(LRCSQ)
IF '$ORDER(^TMP("LRCAP",LRCSQ,DUZ,0))
KILL ^TMP("LRCAP",LRCSQ,DUZ),LRCSQ
+2 IF $DATA(LRCSQ)
IF $PIECE(LRPARAM,U,14)
DO STD^LRCAPV
KILL LRIDIV
+3 ;
+4 KILL I12,LRCDEF,LRCDEF0,LRCDEF0X,LRCSQ,LRCW,LRFASTS,LRNTN,LRNX,LRPANEL,LRSSCX,LRDUF0,LRTEC,LRVF,LRXDP,X9,%,L1,LRAD,LREND,LRSN,QUOUT
+5 KILL LRAL,LRALL,LRCAPMS,LRMA,SEX,S2,T1,AGE,N,D0,D1,DOB,I,LRFASTS,LRSLOW,DIR,X3,LRORDXS,LRADXS,LRSNXS,LRWP,LRWPC
+6 KILL LRALERT,LRCSQQ,LRT,LRNOW,LRODTSV,LRSNSV,LRSUF0,LRTSNV,NOW,LRI,LRTNSV
+7 ; ORVP,ORIFN Killed for OE/RR 2.5
+8 KILL ORVP,ORIFN
+9 ;
+10 DO SLOWK
DO ^%ZISC
+11 ;
+12 QUIT
+13 ;
+14 ;
LRWU4 ;
+1 NEW L,LRI,LRADXS,LRSNXS
+2 if '$GET(LRORD)
QUIT
+3 SET LRORDXS=LRORD
SET LRADXS=0
+4 FOR
SET LRADXS=$ORDER(^LRO(69,"C",LRORDXS,LRADXS))
if LRADXS<1
QUIT
Begin DoDot:1
+5 SET LRSNXS=0
+6 FOR
SET LRSNXS=$ORDER(^LRO(69,"C",LRORDXS,LRADXS,LRSNXS))
if LRSNXS<1
QUIT
Begin DoDot:2
+7 KILL LRSLOW
+8 SET LRSN=+LRSNXS
SET LRAD=+LRADXS
SET LRORD=+LRORDXS
+9 if 'LRSN!('LRAD)!('$ORDER(^LRO(69,LRAD,1,LRSN,2,0)))
QUIT
+10 SET LRI=0
+11 FOR
SET LRI=$ORDER(^LRO(69,LRAD,1,LRSN,2,LRI))
if LRI<1
QUIT
Begin DoDot:3
+12 SET L=$GET(^LRO(69,LRAD,1,LRSN,2,LRI,0))
+13 IF $PIECE(L,U,3)
IF $PIECE(L,U,4)
IF $PIECE(L,U,5)
SET LRSLOW($PIECE(L,U,3,5))=""
End DoDot:3
+14 SET LRI=""
+15 FOR
SET LRI=$ORDER(LRSLOW(LRI))
if LRI=""
QUIT
DO GO
End DoDot:2
End DoDot:1
+16 ;
+17 DO SLOWK
+18 QUIT
+19 ;
+20 ;
GO ;
+1 ; Protect variables
+2 NEW LRAA,LRAD,LRAN,LRADXS,LRSNXS
+3 SET LRAD=$PIECE(LRI,U,1)
SET LRAA=$PIECE(LRI,U,2)
SET LRAN=$PIECE(LRI,U,3)
+4 ;
+5 ; Protect subscript variable
+6 NEW LRI
+7 ;
+8 IF $PIECE(LRPARAM,U,14)
IF $PIECE($GET(^LRO(68,LRAA,0)),U,16)
DO ^LRCAPV
if $GET(LREND)
QUIT
+9 ;
+10 ; Check for different performing lab.
+11 IF $GET(LRPL)
NEW LRDUZ
SET LRDUZ(2)=LRPL
+12 ;
+13 DO SLOW^LRVER
+14 QUIT
+15 ;
+16 ;
SLOWK ;
+1 KILL I5,LRCSN,LRORIFN,LRWPC,X4
+2 KILL K,LRACN,LRACN0,LRDAX,LRDOC,LRCDEF,LRCDEF0
+3 KILL LRLBL,LRLBLBP,LRLL,LRLWC,LRMACH,LROD0,LROD1,LROD3,LROOS,LRORD,LROSD,LRYR
+4 KILL LRAA,LRACD,LRAN,LRAOD,LRCAPLOC,LRAOD,LRCDT,LRCFL,LRCODEN,LRCS,LRDAT,LRDEL,LRDFN,LRDPF,LRDV,LRDVF,LREAL,LREDO,LRFFLG,LRFP,LRIDIV,LRIDT,LRIX,LRJ,LRK,LRBLBP,LRLCT,LRLDT,LRLLOC,LRM,LRMAX1
+5 KILL LRMAX2,LRMAXX,LRMETH,LRMX,LRNAME,LRNOCODE,LROLLOC,LROT,LRPR,LRPRAC,LRRB,LRSAMP,LRSAVE,LRSPN,LRSS,LRSSX,LRST,LRSUB,LRSUM,LRSX,LRSXN,LRTEST,LRTN,LRTREA,LRTS,LRTX,LRTY,LRVRM,LRWL0,LRWLC,LRWRD,LRX,LRXD,LRWRD,SSN
+6 KILL DR,GLB,H8,L,S5,T,TT
+7 QUIT
