LRMINEW ;SLC/CJS/BA - NEW DATA TO BE REVIEWED/VERIFIED ;4/24/89 14:36 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
;from option LRMINEWD
ACCESS D ^LRPARAM I $S('$D(LRLABKY):1,'$P(LRLABKY,U):1,1:0) W !,"You must have the 'LRVERIFY' key to verify results.",! Q
BEGIN S LREND=0,LRDAT=LRDT0,LRFREE=0,LRDXZ=DUZ,LRVT="VT" D VER
END K %,%DT,A,AGE,D,DFN,DOB,DTOUT,DUOUT,I,LRAA,LRACC,LRAD,LRAN,LRCDT,LRDAT,LRDFN,LRDPF,LRDXZ,LREND,LRFREE,LRIDT,LRLLOC,LRLLT,LRLOCA,LRLTR,LRMIQUE,LRODT,LROK,LRONESPC,LRONETST,LRPG,LRSB,LRWRD,LRWRDVEW,LRVT,PNM,POP,SEX,SSN,X,Y
Q
VER I $P(LRLABKY,U,2) D SUPER Q:LREND
K DIC D LRAA^LRMIUT Q:LRAA<1
S %DT="AE",%DT("A")="Micro Accession Year: ("_$E(DT,2,3)_")//" D ^%DT K %DT("A") Q:X[U S:X="" Y=$E(DT,1,3) S LRAD=$E(Y,1,3)_"0000"
F I=0:0 D AREA Q:LREND D EXCLUDE Q:%=1
I LREND Q
S LRAN=0 F I=0:0 S LRAN=$O(LRAN(LRAN)) Q:LRAN="" K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
F I=0:0 W !!,"Would you like to review the data as the (W)ards will see it, as",!,"the (L)ab will see it, or (N)ot review the data? W// " R X:DTIME S:'$T X=U S:'$L(X) X="W" Q:X[U!("WLN"[X&($L(X)=1)) D INFO
I X'[U S:X="W" LRWRDVEW="" D @$S(X="N":"^LRMINEW1",1:"^LRMINEW2")
Q
AREA F I=0:0 R !!,"Area to review:",!?20,"1 Bacteriology",!?20,"2 Mycology",!?20,"3 Parasitology",!?20,"4 Mycobacteriology",!?20,"5 Virology",!,"Choice: ",X:DTIME Q:X>0&(X<6)&(X?1N)!(X=""!(X=U)) W !,"Enter a number 1,2,3,4 or 5"
I X=""!(X=U) S LREND=1 Q
S LRSB=$S(X=1:1,X=2:8,X=3:5,X=4:11,X=5:16,1:"")
Q
EXCLUDE W !!,"Here's what's been edited:",!
S LRAN=0 F I=0:0 S LRAN=$O(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) Q:LRAN<1 S A=^(LRAN) D:+A=LRDXZ!(LRDXZ=0) SHOW
W !!,"Indicate those you wish to permanently exclude (unless re-edited) from review."
D CHECK^LRMINEW1 I $O(LRAN(0))'>0 S %=1 Q
W !,"Excluding the following:" S LRAN=0 F I=0:0 S LRAN=$O(LRAN(LRAN)) Q:LRAN="" W !,LRAN
F I=0:0 W !!,"Are you sure you want to exclude" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
Q
SHOW Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) Q:'$D(^(3)) S LRDFN=+^(0),LRIDT=9999999-^(3)
I '$D(^LR(LRDFN,"MI",LRIDT,LRSB)) K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN) Q
S Y=+^LR(LRDFN,"MI",LRIDT,LRSB) D D^LRU S LRMAPDT=Y
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,LRAN,?6,PNM,?36,SSN W:$P(A,U,2) ?49,"Approved"," ",LRMAPDT K LRMAPDT
Q
SUPER F I=0:0 W !,"Verify all work edited for a given area" S %=2 D YN^DICN Q:% W !,"You may verify one person's work or all person's work."
I %=-1 S LREND=1 Q
I %=1 S LRDXZ=0 Q
S DIC(0)="AEQM",DIC("A")="Whose work?: ",DIC="^VA(200," D ^DIC S:X[U LREND=1 Q:Y<1 S LRDXZ=+Y
Q
INFO W !!,"Answer 'W', 'L', 'N' or '^' to exit.",!,"Ward copies may have certain data suppressed from review.",!,"If you've already reviewed the data, answer 'N' to approve the data."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMINEW 2810 printed Oct 16, 2024@18:17:50 Page 2
LRMINEW ;SLC/CJS/BA - NEW DATA TO BE REVIEWED/VERIFIED ;4/24/89 14:36 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 ;from option LRMINEWD
ACCESS DO ^LRPARAM
IF $SELECT('$DATA(LRLABKY):1,'$PIECE(LRLABKY,U):1,1:0)
WRITE !,"You must have the 'LRVERIFY' key to verify results.",!
QUIT
BEGIN SET LREND=0
SET LRDAT=LRDT0
SET LRFREE=0
SET LRDXZ=DUZ
SET LRVT="VT"
DO VER
END KILL %,%DT,A,AGE,D,DFN,DOB,DTOUT,DUOUT,I,LRAA,LRACC,LRAD,LRAN,LRCDT,LRDAT,LRDFN,LRDPF,LRDXZ,LREND,LRFREE,LRIDT,LRLLOC,LRLLT,LRLOCA,LRLTR,LRMIQUE,LRODT,LROK,LRONESPC,LRONETST,LRPG,LRSB,LRWRD,LRWRDVEW,LRVT,PNM,POP,SEX,SSN,X,Y
+1 QUIT
VER IF $PIECE(LRLABKY,U,2)
DO SUPER
if LREND
QUIT
+1 KILL DIC
DO LRAA^LRMIUT
if LRAA<1
QUIT
+2 SET %DT="AE"
SET %DT("A")="Micro Accession Year: ("_$EXTRACT(DT,2,3)_")//"
DO ^%DT
KILL %DT("A")
if X[U
QUIT
if X=""
SET Y=$EXTRACT(DT,1,3)
SET LRAD=$EXTRACT(Y,1,3)_"0000"
+3 FOR I=0:0
DO AREA
if LREND
QUIT
DO EXCLUDE
if %=1
QUIT
+4 IF LREND
QUIT
+5 SET LRAN=0
FOR I=0:0
SET LRAN=$ORDER(LRAN(LRAN))
if LRAN=""
QUIT
KILL ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
+6 FOR I=0:0
WRITE !!,"Would you like to review the data as the (W)ards will see it, as",!,"the (L)ab will see it, or (N)ot review the data? W// "
READ X:DTIME
if '$TEST
SET X=U
if '$LENGTH(X)
SET X="W"
if X[U!("WLN"[X&($LENGTH(X)=1))
QUIT
DO INFO
+7 IF X'[U
if X="W"
SET LRWRDVEW=""
DO @$SELECT(X="N":"^LRMINEW1",1:"^LRMINEW2")
+8 QUIT
AREA FOR I=0:0
READ !!,"Area to review:",!?20,"1 Bacteriology",!?20,"2 Mycology",!?20,"3 Parasitology",!?20,"4 Mycobacteriology",!?20,"5 Virology",!,"Choice: ",X:DTIME
if X>0&(X<6)&(X?1N)!(X=""!(X=U))
QUIT
WRITE !,"Enter a number 1,2,3,4 or 5"
+1 IF X=""!(X=U)
SET LREND=1
QUIT
+2 SET LRSB=$SELECT(X=1:1,X=2:8,X=3:5,X=4:11,X=5:16,1:"")
+3 QUIT
EXCLUDE WRITE !!,"Here's what's been edited:",!
+1 SET LRAN=0
FOR I=0:0
SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN))
if LRAN<1
QUIT
SET A=^(LRAN)
if +A=LRDXZ!(LRDXZ=0)
DO SHOW
+2 WRITE !!,"Indicate those you wish to permanently exclude (unless re-edited) from review."
+3 DO CHECK^LRMINEW1
IF $ORDER(LRAN(0))'>0
SET %=1
QUIT
+4 WRITE !,"Excluding the following:"
SET LRAN=0
FOR I=0:0
SET LRAN=$ORDER(LRAN(LRAN))
if LRAN=""
QUIT
WRITE !,LRAN
+5 FOR I=0:0
WRITE !!,"Are you sure you want to exclude"
SET %=2
DO YN^DICN
if %
QUIT
WRITE !,"Answer 'Y'es or 'N'o"
+6 QUIT
SHOW if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
QUIT
if '$DATA(^(3))
QUIT
SET LRDFN=+^(0)
SET LRIDT=9999999-^(3)
+1 IF '$DATA(^LR(LRDFN,"MI",LRIDT,LRSB))
KILL ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
QUIT
+2 SET Y=+^LR(LRDFN,"MI",LRIDT,LRSB)
DO D^LRU
SET LRMAPDT=Y
+3 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
DO PT^LRX
WRITE !,LRAN,?6,PNM,?36,SSN
if $PIECE(A,U,2)
WRITE ?49,"Approved"," ",LRMAPDT
KILL LRMAPDT
+4 QUIT
SUPER FOR I=0:0
WRITE !,"Verify all work edited for a given area"
SET %=2
DO YN^DICN
if %
QUIT
WRITE !,"You may verify one person's work or all person's work."
+1 IF %=-1
SET LREND=1
QUIT
+2 IF %=1
SET LRDXZ=0
QUIT
+3 SET DIC(0)="AEQM"
SET DIC("A")="Whose work?: "
SET DIC="^VA(200,"
DO ^DIC
if X[U
SET LREND=1
if Y<1
QUIT
SET LRDXZ=+Y
+4 QUIT
INFO WRITE !!,"Answer 'W', 'L', 'N' or '^' to exit.",!,"Ward copies may have certain data suppressed from review.",!,"If you've already reviewed the data, answer 'N' to approve the data."
+1 QUIT
