LRMINEW.m

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 ---LRMINEW   2810     printed  Feb 18, 2025@23:42:58                                                                                                                                                                                                     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