LRVER ;DALOI/CJS/FHS - LAB ROUTINE DATA VERIFICATION ; 22-Oct-2013 09:22 ; MKK
;;5.2;LAB SERVICE;**1027,1030,1033**;NOV 01, 1997
;
;;VA LR Patch(s): 153,286
;
EP ; EP -- IHS/OIT/MKK - LR*5.2*1033
D ^LRPARAM
S LRCW=8,LREND=0,LRPANEL=0,LRUID=""
K DIC,LRPER,DUOUT
D REV
I LREND D QUIT Q
D VERDIS
I LREND D QUIT Q
D CMTDSP^LRVERA
S (LRAA,LRAD,LRAN)=0
N LRVBY S LRVBY=$$SELBY^LRWU4("Verify by")
D:LRVBY=1 ^LRVERA D:LRVBY=2 UID^LRVERA
I 'LRVBY!(LRAA<1) D QUIT Q
S X=$$SELPL^LRVERA(DUZ(2))
I X<1 D QUIT Q
I X'=DUZ(2) N LRDUZ S LRDUZ(2)=X
I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV G QUIT:$G(LREND)
SLOW S LRSS=$P(^LRO(68,LRAA,0),U,2)
;
I LRSS="MI" D Q
. S X=DUZ D DUZ^LRX S LRTEC=LRUSI
. S LRPTP=-1,LRMIDEF=$P(^LAB(69.9,1,1),U,10),LRMIOTH=$P(^(1),U,11)
. D ^LRMIEDZ2,END^LRMIEDZ,QUIT
;
I LRSS'="CH" G QUIT
;
; The rest of the code only works on the "CH" area.
DAT I LRAD<1 D ADATE^LRWU
Q:LRAD<1
S %H=$H-$P(^LAB(69.9,1,0),U,7) D YMD^%DTC S LRTM60=9999999-X
I LRAN>0 D WLN1 G QUIT:$G(LREND) G L11
I $P(^LRO(68,LRAA,0),U,3)="D" S I=0 F S I=$O(^LRO(68,LRAA,1,LRAD,1,I)) Q:I<1 I $D(^LRO(68,LRAA,1,LRAD,1,I,3)),'$P(^(3),U,4) S LRAN=I Q
S:$D(^LRO(68,LRAA,1,LRAD,2))&(LRAN<1) LRAN=$P(^(2),U,4)
;
L10 K LRTEST,LRSET,LRLDT,DIC,LRNAME,LRNG,LRDEL,T,LRTX,LRFP,LRAB,LRVERVER,Y,Z
G QUIT:$G(LREND) D WLN G QUIT:$G(LREND)
;
L11 I $D(LRFASTS) D ^LRVER1,SLOWK^LRFASTS Q
D ^LRVER1,NEXT
G L10
;
YN S DUOUT=0 S:'$D(%) %=1 D YN^DICN S:%<0 DUOUT=1 W:%=0 !,"Answer with a YES or NO or '^' to exit" Q:% G YN
;
WLN ; I LRVBY=2 S:LRAN<1 LRUID="" S:$L(LRAN) LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^") D UID^LRVERA G LREND:LRUID="" G WLN1
I LRVBY=2 S:LRAN<1 LRUID="" S:$L(LRAN)&(+$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0))) LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^") D UID^LRVERA G LREND:LRUID="" G WLN1 ; IHS/OIT/MKK - LR*5.2*1030 -- Get rid of Naked References
;
S:LRAN<1 LRAN=""
K DIR,DIRUT,DTOUT,DUOUT
S DIR(0)="NAO^1:999999:0"
S DIR("A")="Accession NUMBER: ",DIR("?")="^D LW^LRVR"
I LRAN'="" S DIR("B")=LRAN
D ^DIR K DIR
I $D(DIRUT) G LREND
S LRAN=Y
G WLN:LRAN=""
WLN1 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W !,"Accession does not exist." D NEXT G WLN
S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRORD=$S($D(^(.1)):^(.1),1:0),LRODT=+$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=+$P(^(0),U,5)
I LRDFN<1 W !,"Accession's LRDFN invalid." D NEXT G WLN ; IHS/OIT/MKK - LR*5.2*1033
S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
; W !,PNM,?30,SSN
;----- BEGIN IHS MODIFICATIONS LR*5.2*1027
W !,PNM,?30,HRCN
;----- END IHS MODIFICATIONS LR*5.2*1027
W:LRDPF=2 " LOC:",$S($L(LRWRD):LRWRD,1:$S($L($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)):$P(^(0),U,7),1:"??"))
W !
S LRCDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U)
; If no lab arrival time then have user update order/accession
I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3) D
. N %DT,LRA1,LRA2,LRA3
. S %DT("B")=$$FMTE^XLFDT(LRCDT,"1")
. S LRSTATUS="C",LRA1=LRAA,LRA2=LRAD,LRA3=LRAN
. D P15^LROE1
. S LRAA=LRA1,LRAD=LRA2,LRAN=LRA3
. Q:LRCDT<1
. I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3) S $P(^(3),U,3)=$$NOW^XLFDT
; If user did not update then go to next accession
I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3) D NEXT G WLN
S LRCDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U)
I $G(LRCDT)<1 S LRCDT=1 D NEXT G WLN
; Check for valid pointer to file #63 and entry in file #63.
S LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
I LRIDT<1 D G WLN
. W !,">>>>ERROR - NO POINTER TO FILE #63 - PLEASE NOTIFY SYSTEM MANAGER<<<<<",!
. D NEXT
I '$D(^LR(LRDFN,"CH",LRIDT,0)) D G WLN
. W !,">>>>ERROR - NO ENTRY IN FILE #63 - PLEASE NOTIFY SYSTEM MANAGER<<<<<",!
. D NEXT
I $D(^LRO(69,LRODT,1,LRSN)),'$D(^(LRSN,1)) W !,"This Order # has not been collected",$C(7) D NEXT G WLN
I $D(^LRO(69,LRODT,1,LRSN,1)),$P(^LRO(69,LRODT,1,LRSN,1),U,4)'="C" W !,"You cannot verify an accession which has not been collected.",$C(7) D NEXT G WLN
Q
;
;
LREND I $D(^LRO(68,LRAA,1,LRAD,0)) S:'$D(^(2)) ^(2)="^^" S ^(2)=$P(^(2),U,1,3)_U_LRAN_U_$P(^(2),U,5,99)
S LREND=1 K ^TMP("LR",$J,"TMP"),LRORD,LRM
Q
;
;
NEXT ;
S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN))
I LRAN<1 W !,"LAST IN WORK LIST" S LRAN="",LREND=1
Q
;
;
QUIT ;
I $D(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) K ^XTMP("LRCAP",LRCSQ,DUZ),LRCSQ
I $D(LRCSQ),$D(LRAA),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV
;
SLOQ ;
D STOP^LRCAPV,^LRCAPV2
K %,A,AGE,D1,DFN,DIC,DIE,DIR,DL,DLAYGO,DOB,DQ,DR,DX,I,J,LRACC,LRVF,LRCDT,LRCW,LRDAT,LRDFN,LRDPF,LRDV,LRDVF,LREAL,LREDIT,LREND,LRFLG,LRIDT,LRINI,LRLCT,LRLLOC,LRMETH,LRNG2,LRNG3,LRAD,LRAN,LRSPEC,LRPER,LRALL
K LRNG4,LRNG5,LRNT,LRNTN,LRNX,LRODT,LROUTINE,LROWLE,LRSAMP,LRSN,LRSS,LRSSP,LRSUB,LRTEC,LRTN,LRTS,LRUSI,LRUSNM,LRWRD,LRXD,LRXDP,PNM,S,SEX,SSN,X,X1,X2,X3,Y,Z,VA("BID"),VA("PID")
K %DT,%H,%X,%Y,B,C,D,DA,DR,G,G1,G2,G4,LRACD,LRAOD,LREDT,LREXEC,LRGVP,LRIOZERO,LRM,LRMA,LRNAME,LRORD,LRPLOC,LRSA,LRSB,LRSDT,LRSSQ,LRTK,LRTX,LRURG,LRVOL,LRVRM,LRWDTL,LRXDH,N,POP,T1,X9,Z1,Z2,^TMP("LR",$J)
K LRT,LRCFL,D0,GLB,LRAA,LRCNT,LRCODE,LRCODEN,LRCMTDSP,LRCWT,LRI,LRNOW,LRP,LRPN,LRQC,LRSSC,LRSSCX,LRSTD,NODE,NODE0,NOW,S2,ZTSK,Y,LRTIME,LRMAX2,LRMAXX,LRMX,LRODTSV,LRSNSV,LRSPN,LRTNSV,LRTY
; K W,Y,Z,Z1,Z2,I1,LRALERT,LRDIYCNT,LRNOCODE,LRREP,LRSTATUS,LRUN,LRX,LRTIM,LRAL,LRPANEL,LRTM60,LRNDISP
; D KVA^VADPT K LRIDIV,LROLLOC,LRORIFN,LRPRAC,LRRB,LRSD,LRTREA,LRTT,LRUID
;----- BEGIN IHS MODIFICATIONS LR*5.2*1027
K HRCN
K W,Y,Z,Z1,Z2,LRALERT,LRDIYCNT,LRNOCODE,LRREP,LRSTATUS,LRUN,LRX,LRTIM,LRAL,LRPANEL,LRTM60,LRNDISP
D @$S($$ISPIMS^BLRUTIL:"KVA^VADPT",1:"KVA^BLRDPT")
K LRIDIV,LROLLOC,LRORIFN,LRPRAC,LRRB,LRSD,LRTREA,LRTT,LRUID
;----- END IHS MODIFICATIONS LR*5.2*1027
K NAME,LRSUFO,LRCSQQ
Q
;
;
REV ; Ask if user wants to review data before and after editing
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="YES"
S DIR("A")="Do you want to review the data before and after you edit"
S DIR("?",1)="Answer YES, and the data will be displayed in its entirety as a panel before"
S DIR("?",2)="you edit if data already exists, and will be displayed after you edit."
S DIR("?")="NO, will skip the extra displays."
D ^DIR
I $D(DIRUT) S LREND=1
I Y=0 S LRPER=""
Q
;
;
VERDIS ; Prevent test not selected by the user with verified data
; entered from being displayed on the editing screens.
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")="Do you wish to see all previously verified results"
S DIR("?",1)="Do you want to see every test that has results entered"
S DIR("?",2)="or only the test(s) you select to edit "
S DIR("?")="Answer with YES or NO"
D ^DIR
I $D(DIRUT) S LREND=1
I Y=0 S LRNDISP=1
Q
LRVER ;DALOI/CJS/FHS - LAB ROUTINE DATA VERIFICATION ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;LAB SERVICE;**1027,1030,1033**;NOV 01, 1997
+2 ;
+3 ;;VA LR Patch(s): 153,286
+4 ;
EP ; EP -- IHS/OIT/MKK - LR*5.2*1033
+1 DO ^LRPARAM
+2 SET LRCW=8
SET LREND=0
SET LRPANEL=0
SET LRUID=""
+3 KILL DIC,LRPER,DUOUT
+4 DO REV
+5 IF LREND
DO QUIT
QUIT
+6 DO VERDIS
+7 IF LREND
DO QUIT
QUIT
+8 DO CMTDSP^LRVERA
+9 SET (LRAA,LRAD,LRAN)=0
+10 NEW LRVBY
SET LRVBY=$$SELBY^LRWU4("Verify by")
+11 IF LRVBY=1
DO ^LRVERA
IF LRVBY=2
DO UID^LRVERA
+12 IF 'LRVBY!(LRAA<1)
DO QUIT
QUIT
+13 SET X=$$SELPL^LRVERA(DUZ(2))
+14 IF X<1
DO QUIT
QUIT
+15 IF X'=DUZ(2)
NEW LRDUZ
SET LRDUZ(2)=X
+16 IF $PIECE(LRPARAM,U,14)
IF $PIECE($GET(^LRO(68,LRAA,0)),U,16)
DO ^LRCAPV
IF $GET(LREND)
GOTO QUIT
SLOW SET LRSS=$PIECE(^LRO(68,LRAA,0),U,2)
+1 ;
+2 IF LRSS="MI"
Begin DoDot:1
+3 SET X=DUZ
DO DUZ^LRX
SET LRTEC=LRUSI
+4 SET LRPTP=-1
SET LRMIDEF=$PIECE(^LAB(69.9,1,1),U,10)
SET LRMIOTH=$PIECE(^(1),U,11)
+5 DO ^LRMIEDZ2
DO END^LRMIEDZ
DO QUIT
End DoDot:1
QUIT
+6 ;
+7 IF LRSS'="CH"
GOTO QUIT
+8 ;
+9 ; The rest of the code only works on the "CH" area.
DAT IF LRAD<1
DO ADATE^LRWU
+1 IF LRAD<1
QUIT
+2 SET %H=$HOROLOG-$PIECE(^LAB(69.9,1,0),U,7)
DO YMD^%DTC
SET LRTM60=9999999-X
+3 IF LRAN>0
DO WLN1
IF $GET(LREND)
GOTO QUIT
GOTO L11
+4 IF $PIECE(^LRO(68,LRAA,0),U,3)="D"
SET I=0
FOR
SET I=$ORDER(^LRO(68,LRAA,1,LRAD,1,I))
IF I<1
QUIT
IF $DATA(^LRO(68,LRAA,1,LRAD,1,I,3))
IF '$PIECE(^(3),U,4)
SET LRAN=I
QUIT
+5 IF $DATA(^LRO(68,LRAA,1,LRAD,2))&(LRAN<1)
SET LRAN=$PIECE(^(2),U,4)
+6 ;
L10 KILL LRTEST,LRSET,LRLDT,DIC,LRNAME,LRNG,LRDEL,T,LRTX,LRFP,LRAB,LRVERVER,Y,Z
+1 IF $GET(LREND)
GOTO QUIT
DO WLN
IF $GET(LREND)
GOTO QUIT
+2 ;
L11 IF $DATA(LRFASTS)
DO ^LRVER1
DO SLOWK^LRFASTS
QUIT
+1 DO ^LRVER1
DO NEXT
+2 GOTO L10
+3 ;
YN SET DUOUT=0
IF '$DATA(%)
SET %=1
DO YN^DICN
IF %<0
SET DUOUT=1
IF %=0
WRITE !,"Answer with a YES or NO or '^' to exit"
IF %
QUIT
GOTO YN
+1 ;
WLN ; I LRVBY=2 S:LRAN<1 LRUID="" S:$L(LRAN) LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^") D UID^LRVERA G LREND:LRUID="" G WLN1
+1 ; IHS/OIT/MKK - LR*5.2*1030 -- Get rid of Naked References
IF LRVBY=2
IF LRAN<1
SET LRUID=""
IF $LENGTH(LRAN)&(+$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,0)))
SET LRUID=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
DO UID^LRVERA
IF LRUID=""
GOTO LREND
GOTO WLN1
+2 ;
+3 IF LRAN<1
SET LRAN=""
+4 KILL DIR,DIRUT,DTOUT,DUOUT
+5 SET DIR(0)="NAO^1:999999:0"
+6 SET DIR("A")="Accession NUMBER: "
SET DIR("?")="^D LW^LRVR"
+7 IF LRAN'=""
SET DIR("B")=LRAN
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
GOTO LREND
+10 SET LRAN=Y
+11 IF LRAN=""
GOTO WLN
WLN1 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
WRITE !,"Accession does not exist."
DO NEXT
GOTO WLN
+1 SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRORD=$SELECT($DATA(^(.1)):^(.1),1:0)
SET LRODT=+$SELECT($PIECE(^(0),U,4):$PIECE(^(0),U,4),1:$PIECE(^(0),U,3))
SET LRSN=+$PIECE(^(0),U,5)
+2 ; IHS/OIT/MKK - LR*5.2*1033
IF LRDFN<1
WRITE !,"Accession's LRDFN invalid."
DO NEXT
GOTO WLN
+3 SET LRUID=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
+4 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
DO PT^LRX
+5 ; W !,PNM,?30,SSN
+6 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1027
+7 WRITE !,PNM,?30,HRCN
+8 ;----- END IHS MODIFICATIONS LR*5.2*1027
+9 IF LRDPF=2
WRITE " LOC:",$SELECT($LENGTH(LRWRD):LRWRD,1:$SELECT($LENGTH($PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,7)):$PIECE(^(0),U,7),1:"??"))
+10 WRITE !
+11 SET LRCDT=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U)
+12 ; If no lab arrival time then have user update order/accession
+13 IF '$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3)
Begin DoDot:1
+14 NEW %DT,LRA1,LRA2,LRA3
+15 SET %DT("B")=$$FMTE^XLFDT(LRCDT,"1")
+16 SET LRSTATUS="C"
SET LRA1=LRAA
SET LRA2=LRAD
SET LRA3=LRAN
+17 DO P15^LROE1
+18 SET LRAA=LRA1
SET LRAD=LRA2
SET LRAN=LRA3
+19 IF LRCDT<1
QUIT
+20 IF '$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3)
SET $PIECE(^(3),U,3)=$$NOW^XLFDT
End DoDot:1
+21 ; If user did not update then go to next accession
+22 IF '$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,3)
DO NEXT
GOTO WLN
+23 SET LRCDT=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U)
+24 IF $GET(LRCDT)<1
SET LRCDT=1
DO NEXT
GOTO WLN
+25 ; Check for valid pointer to file #63 and entry in file #63.
+26 SET LRIDT=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
+27 IF LRIDT<1
Begin DoDot:1
+28 WRITE !,">>>>ERROR - NO POINTER TO FILE #63 - PLEASE NOTIFY SYSTEM MANAGER<<<<<",!
+29 DO NEXT
End DoDot:1
GOTO WLN
+30 IF '$DATA(^LR(LRDFN,"CH",LRIDT,0))
Begin DoDot:1
+31 WRITE !,">>>>ERROR - NO ENTRY IN FILE #63 - PLEASE NOTIFY SYSTEM MANAGER<<<<<",!
+32 DO NEXT
End DoDot:1
GOTO WLN
+33 IF $DATA(^LRO(69,LRODT,1,LRSN))
IF '$DATA(^(LRSN,1))
WRITE !,"This Order # has not been collected",$CHAR(7)
DO NEXT
GOTO WLN
+34 IF $DATA(^LRO(69,LRODT,1,LRSN,1))
IF $PIECE(^LRO(69,LRODT,1,LRSN,1),U,4)'="C"
WRITE !,"You cannot verify an accession which has not been collected.",$CHAR(7)
DO NEXT
GOTO WLN
+35 QUIT
+36 ;
+37 ;
LREND IF $DATA(^LRO(68,LRAA,1,LRAD,0))
IF '$DATA(^(2))
SET ^(2)="^^"
SET ^(2)=$PIECE(^(2),U,1,3)_U_LRAN_U_$PIECE(^(2),U,5,99)
+1 SET LREND=1
KILL ^TMP("LR",$JOB,"TMP"),LRORD,LRM
+2 QUIT
+3 ;
+4 ;
NEXT ;
+1 SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))
+2 IF LRAN<1
WRITE !,"LAST IN WORK LIST"
SET LRAN=""
SET LREND=1
+3 QUIT
+4 ;
+5 ;
QUIT ;
+1 IF $DATA(LRCSQ)
IF '$ORDER(^XTMP("LRCAP",LRCSQ,DUZ,0))
KILL ^XTMP("LRCAP",LRCSQ,DUZ),LRCSQ
+2 IF $DATA(LRCSQ)
IF $DATA(LRAA)
IF $PIECE($GET(^LRO(68,+LRAA,0)),U,16)
DO STD^LRCAPV
+3 ;
SLOQ ;
+1 DO STOP^LRCAPV
DO ^LRCAPV2
+2 KILL %,A,AGE,D1,DFN,DIC,DIE,DIR,DL,DLAYGO,DOB,DQ,DR,DX,I,J,LRACC,LRVF,LRCDT,LRCW,LRDAT,LRDFN,LRDPF,LRDV,LRDVF,LREAL,LREDIT,LREND,LRFLG,LRIDT,LRINI,LRLCT,LRLLOC,LRMETH,LRNG2,LRNG3,LRAD,LRAN,LRSPEC,LRPER,LRALL
+3 KILL LRNG4,LRNG5,LRNT,LRNTN,LRNX,LRODT,LROUTINE,LROWLE,LRSAMP,LRSN,LRSS,LRSSP,LRSUB,LRTEC,LRTN,LRTS,LRUSI,LRUSNM,LRWRD,LRXD,LRXDP,PNM,S,SEX,SSN,X,X1,X2,X3,Y,Z,VA("BID"),VA("PID")
+4 KILL %DT,%H,%X,%Y,B,C,D,DA,DR,G,G1,G2,G4,LRACD,LRAOD,LREDT,LREXEC,LRGVP,LRIOZERO,LRM,LRMA,LRNAME,LRORD,LRPLOC,LRSA,LRSB,LRSDT,LRSSQ,LRTK,LRTX,LRURG,LRVOL,LRVRM,LRWDTL,LRXDH,N,POP,T1,X9,Z1,Z2,^TMP("LR",$JOB)
+5 KILL LRT,LRCFL,D0,GLB,LRAA,LRCNT,LRCODE,LRCODEN,LRCMTDSP,LRCWT,LRI,LRNOW,LRP,LRPN,LRQC,LRSSC,LRSSCX,LRSTD,NODE,NODE0,NOW,S2,ZTSK,Y,LRTIME,LRMAX2,LRMAXX,LRMX,LRODTSV,LRSNSV,LRSPN,LRTNSV,LRTY
+6 ; K W,Y,Z,Z1,Z2,I1,LRALERT,LRDIYCNT,LRNOCODE,LRREP,LRSTATUS,LRUN,LRX,LRTIM,LRAL,LRPANEL,LRTM60,LRNDISP
+7 ; D KVA^VADPT K LRIDIV,LROLLOC,LRORIFN,LRPRAC,LRRB,LRSD,LRTREA,LRTT,LRUID
+8 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1027
+9 KILL HRCN
+10 KILL W,Y,Z,Z1,Z2,LRALERT,LRDIYCNT,LRNOCODE,LRREP,LRSTATUS,LRUN,LRX,LRTIM,LRAL,LRPANEL,LRTM60,LRNDISP
+11 DO @$SELECT($$ISPIMS^BLRUTIL:"KVA^VADPT",1:"KVA^BLRDPT")
+12 KILL LRIDIV,LROLLOC,LRORIFN,LRPRAC,LRRB,LRSD,LRTREA,LRTT,LRUID
+13 ;----- END IHS MODIFICATIONS LR*5.2*1027
+14 KILL NAME,LRSUFO,LRCSQQ
+15 QUIT
+16 ;
+17 ;
REV ; Ask if user wants to review data before and after editing
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 SET DIR(0)="YO"
SET DIR("B")="YES"
+3 SET DIR("A")="Do you want to review the data before and after you edit"
+4 SET DIR("?",1)="Answer YES, and the data will be displayed in its entirety as a panel before"
+5 SET DIR("?",2)="you edit if data already exists, and will be displayed after you edit."
+6 SET DIR("?")="NO, will skip the extra displays."
+7 DO ^DIR
+8 IF $DATA(DIRUT)
SET LREND=1
+9 IF Y=0
SET LRPER=""
+10 QUIT
+11 ;
+12 ;
VERDIS ; Prevent test not selected by the user with verified data
+1 ; entered from being displayed on the editing screens.
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+3 SET DIR(0)="YO"
SET DIR("B")="NO"
+4 SET DIR("A")="Do you wish to see all previously verified results"
+5 SET DIR("?",1)="Do you want to see every test that has results entered"
+6 SET DIR("?",2)="or only the test(s) you select to edit "
+7 SET DIR("?")="Answer with YES or NO"
+8 DO ^DIR
+9 IF $DATA(DIRUT)
SET LREND=1
+10 IF Y=0
SET LRNDISP=1
+11 QUIT
