LRMISTF.m

LRMISTF ;SLC/CJS/BA - MASS DATA ENTRY INTO FILE 63.05 ;4/24/89  14:40 ; [ 04/14/2003  10:04 AM ]

 ;;5.2T9;LR;**1004,1018**;Nov 17, 2004

 ;;5.2;LAB SERVICE;**153**;Sep 27, 1994

 ;from option LRMISTUF

ACCESS I '$D(^XUSEC("LRVERIFY",DUZ)) W !,"You're not cleared for this option. You must have the LRVERIFY Key." Q

BEGIN ;D ^LRPARAM Q:$G(LREND)  S LREND=0,LRVT="RE",LRSBS="13^11.6^11.57^11.58^17^15.51^21^19.6^27^24^37",(Z(13),Z(11.6),Z(11.57),Z(11.58))=1,(Z(17),Z(15.51))=5,(Z(21),Z(19.6))=8,(Z(27),Z(24))=11,Z(37)=16

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 D ^LRPARAM Q:$G(LREND)  S LREND=0,LRVT="RE",LRSBS="13^11.6^11.57^11.58^11.7^17^15.51^21^19.6^27^24^37",(Z(13),Z(11.6),Z(11.57),Z(11.58))=1,Z(11.7)=1,(Z(17),Z(15.51))=5,(Z(21),Z(19.6))=8,(Z(27),Z(24))=11,Z(37)=16

 ;IHS/ANMC/CLS 08/18/96 added 11.7 and Z(11.7)

 ;----- END IHS MODIFICATIONS

 S LRMIMASS=1

 D ASK

 I $D(LRCSQ),$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) D STD^LRCAPV

END D ANN^LRMIEDZ,^LRGVK

 ;K %,AGE,DA,D1,DFN,DIC,DIE,DLAYGO,DOB,DQ,DR,H9,I,J,K,LRAA,LRAD,LRAN,LRCDT,LRCO,LRDFN,LRDPF,LRECODE,LREND,LRIDT,LRLLOC,LRMF,LRMODE,LROK,LRNOP,LRPF,LRSB,LRSBCNT,LRSBS,LRSCREEN,LRTEST,LRWRD,LRVT,POP,PNM,R,SEX,SSN,X,X1,X2,Y,Z

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 K %,AGE,DA,D1,DFN,DIC,DIE,DLAYGO,DOB,DQ,DR,H9,I,J,K,LRAA,LRAD,LRAN,LRCDT,LRCO,LRDFN,LRDPF,LRECODE,LREND,LRIDT,LRLLOC,LRMF,LRMODE,LROK,LRNOP,LRPF,LRSB,LRSBCNT,LRSBS,LRSCREEN,LRTEST,LRWRD,LRVT,POP,PNM,R,SEX,SSN,HRCN,X,X1,X2,Y,Z

 ;IHS/ANMC/CLS 08/18/96

 ;----- END IHS MODIFICATIONS

 K LRMIMASS

 Q

ASK D LRAA^LRMIUT Q:LRAA<1  S LRSS=$P(^LRO(68,LRAA,0),U,2)

 I LRSS="" W !?5,"Accession Area LR SUBSCRIPT is misssing.",! Q

 I $P(LRPARAM,U,14) D ^LRCAPV G:LREND ANN^LRMIEDZ

 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"

 S DIC="^LAB(60,",DIC("A")="Select MICROBIOLOGY TEST: ",DIC(0)="AEMOQ",DIC("S")="I $P(^(0),U,4)=""MI"",$L($P(^(0),U,14))" D ^DIC K DIC Q:Y<1  S LRTEST=+Y

 S LRECODE=$P(^LAB(60,LRTEST,0),U,14),LRECODE=$S($D(^LAB(62.07,LRECODE,.1)):^(.1),1:"")

 K LRSB S LRSBCNT=0 F LRSB=1:1 S X=$P(LRSBS,U,LRSB) Q:'X  S X1=""""_X,X2=";"_X I LRECODE[X,LRECODE[X1!(LRECODE[X2) S LRSB(X)="",LRSBCNT=LRSBCNT+1

 I 'LRSBCNT W "Test does not have an appropriate entry in the EDIT CODE" Q

 F I=0:0 R !,"Preliminary or Final: ",X:DTIME Q:'$T!(X[U)!(X="P")!(X="F")  W !,"Enter ""P"" or ""F""."

 Q:'$T!(X[U)  S LRPF=X

 I LRSBCNT=1 S H9=$O(LRSB(0)),LRSB=Z(H9),LRMF=$P(^DD(63.05,H9,0),U) W !,LRMF K DIC

 I LRSBCNT'=1 S DIC("A")="Enter the field to edit: ",DIC(0)="AE",DIC("S")="I $D(LRSB(+Y))",DIC="^DD(63.05," D ^DIC K DIC Q:Y<1  S H9=+Y,LRSB=Z(H9),LRMF=$P(^DD(63.05,H9,0),U)

 F I=0:0 R !,"1  Automatically enter your entry.",!,"2  Prompt with your entry.",!,"3  Just Prompt.",!,"Choice: ",X:DTIME Q:X=""!(X[U)!(X<4&(X>0)&(X?1N))  D INFO

 Q:X=""!(X[U)  S LRMODE=X

 S:LRMODE<3 LRSCREEN=$S(H9=13:"KM",H9=11.6:"KG",H9=11.58:"KY",H9=17:"KP",H9=15.51:"KW",H9=21:"KF",H9=19.6:"KW",H9=27:"KT",H9=24:"KW",H9=37:"KV",1:"")

 D ^LRMISTF1

 Q

INFO W !,"Enter a number between 1 and 3.",!,"1. Automatically enters the result you specify. You cannot change the entries."

 W !,"2. Automatically enters the result you specify, you can see and change entries",!,"3. Prompts with the field name.  Does not automatically enter data.",!!

 Q

LRMISTF   ;SLC/CJS/BA - MASS DATA ENTRY INTO FILE 63.05 ;4/24/89  14:40 ; [ 04/14/2003  10:04 AM ]

 +1       ;;5.2T9;LR;**1004,1018**;Nov 17, 2004

 +2       ;;5.2;LAB SERVICE;**153**;Sep 27, 1994

 +3       ;from option LRMISTUF

ACCESS     IF '$DATA(^XUSEC("LRVERIFY",DUZ))

               WRITE !,"You're not cleared for this option. You must have the LRVERIFY Key."

               QUIT 

BEGIN     ;D ^LRPARAM Q:$G(LREND)  S LREND=0,LRVT="RE",LRSBS="13^11.6^11.57^11.58^17^15.51^21^19.6^27^24^37",(Z(13),Z(11.6),Z(11.57),Z(11.58))=1,(Z(17),Z(15.51))=5,(Z(21),Z(19.6))=8,(Z(27),Z(24))=11,Z(37)=16

 +1       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +2        DO ^LRPARAM

           IF $GET(LREND)

               QUIT 

           SET LREND=0

           SET LRVT="RE"

           SET LRSBS="13^11.6^11.57^11.58^11.7^17^15.51^21^19.6^27^24^37"

           SET (Z(13),Z(11.6),Z(11.57),Z(11.58))=1

           SET Z(11.7)=1

           SET (Z(17),Z(15.51))=5

           SET (Z(21),Z(19.6))=8

           SET (Z(27),Z(24))=11

           SET Z(37)=16

 +3       ;IHS/ANMC/CLS 08/18/96 added 11.7 and Z(11.7)

 +4       ;----- END IHS MODIFICATIONS

 +5        SET LRMIMASS=1

 +6        DO ASK

 +7        IF $DATA(LRCSQ)

               IF $ORDER(^XTMP("LRCAP",LRCSQ,DUZ,0))

                   DO STD^LRCAPV

END        DO ANN^LRMIEDZ

           DO ^LRGVK

 +1       ;K %,AGE,DA,D1,DFN,DIC,DIE,DLAYGO,DOB,DQ,DR,H9,I,J,K,LRAA,LRAD,LRAN,LRCDT,LRCO,LRDFN,LRDPF,LRECODE,LREND,LRIDT,LRLLOC,LRMF,LRMODE,LROK,LRNOP,LRPF,LRSB,LRSBCNT,LRSBS,LRSCREEN,LRTEST,LRWRD,LRVT,POP,PNM,R,SEX,SSN,X,X1,X2,Y,Z

 +2       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +3        KILL %,AGE,DA,D1,DFN,DIC,DIE,DLAYGO,DOB,DQ,DR,H9,I,J,K,LRAA,LRAD,LRAN,LRCDT,LRCO,LRDFN,LRDPF,LRECODE,LREND,LRIDT,LRLLOC,LRMF,LRMODE,LROK,LRNOP,LRPF,LRSB,LRSBCNT,LRSBS,LRSCREEN,LRTEST,LRWRD,LRVT,POP,PNM,R,SEX,SSN,HRCN,X,X1,X2,Y,Z

 +4       ;IHS/ANMC/CLS 08/18/96

 +5       ;----- END IHS MODIFICATIONS

 +6        KILL LRMIMASS

 +7        QUIT 

ASK        DO LRAA^LRMIUT

           IF LRAA<1

               QUIT 

           SET LRSS=$PIECE(^LRO(68,LRAA,0),U,2)

 +1        IF LRSS=""

               WRITE !?5,"Accession Area LR SUBSCRIPT is misssing.",!

               QUIT 

 +2        IF $PIECE(LRPARAM,U,14)

               DO ^LRCAPV

               IF LREND

                   GOTO ANN^LRMIEDZ

 +3        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"

 +4        SET DIC="^LAB(60,"

           SET DIC("A")="Select MICROBIOLOGY TEST: "

           SET DIC(0)="AEMOQ"

           SET DIC("S")="I $P(^(0),U,4)=""MI"",$L($P(^(0),U,14))"

           DO ^DIC

           KILL DIC

           IF Y<1

               QUIT 

           SET LRTEST=+Y

 +5        SET LRECODE=$PIECE(^LAB(60,LRTEST,0),U,14)

           SET LRECODE=$SELECT($DATA(^LAB(62.07,LRECODE,.1)):^(.1),1:"")

 +6        KILL LRSB

           SET LRSBCNT=0

           FOR LRSB=1:1

               SET X=$PIECE(LRSBS,U,LRSB)

               IF 'X

                   QUIT 

               SET X1=""""_X

               SET X2=";"_X

               IF LRECODE[X

                   IF LRECODE[X1!(LRECODE[X2)

                       SET LRSB(X)=""

                       SET LRSBCNT=LRSBCNT+1

 +7        IF 'LRSBCNT

               WRITE "Test does not have an appropriate entry in the EDIT CODE"

               QUIT 

 +8        FOR I=0:0

               READ !,"Preliminary or Final: ",X:DTIME

               IF '$TEST!(X[U)!(X="P")!(X="F")

                   QUIT 

               WRITE !,"Enter ""P"" or ""F""."

 +9        IF '$TEST!(X[U)

               QUIT 

           SET LRPF=X

 +10       IF LRSBCNT=1

               SET H9=$ORDER(LRSB(0))

               SET LRSB=Z(H9)

               SET LRMF=$PIECE(^DD(63.05,H9,0),U)

               WRITE !,LRMF

               KILL DIC

 +11       IF LRSBCNT'=1

               SET DIC("A")="Enter the field to edit: "

               SET DIC(0)="AE"

               SET DIC("S")="I $D(LRSB(+Y))"

               SET DIC="^DD(63.05,"

               DO ^DIC

               KILL DIC

               IF Y<1

                   QUIT 

               SET H9=+Y

               SET LRSB=Z(H9)

               SET LRMF=$PIECE(^DD(63.05,H9,0),U)

 +12       FOR I=0:0

               READ !,"1  Automatically enter your entry.",!,"2  Prompt with your entry.",!,"3  Just Prompt.",!,"Choice: ",X:DTIME

               IF X=""!(X[U)!(X<4&(X>0)&(X?1N))

                   QUIT 

               DO INFO

 +13       IF X=""!(X[U)

               QUIT 

           SET LRMODE=X

 +14       IF LRMODE<3

               SET LRSCREEN=$SELECT(H9=13:"KM",H9=11.6:"KG",H9=11.58:"KY",H9=17:"KP",H9=15.51:"KW",H9=21:"KF",H9=19.6:"KW",H9=27:"KT",H9=24:"KW",H9=37:"KV",1:"")

 +15       DO ^LRMISTF1

 +16       QUIT 

INFO       WRITE !,"Enter a number between 1 and 3.",!,"1. Automatically enters the result you specify. You cannot change the entries."

 +1        WRITE !,"2. Automatically enters the result you specify, you can see and change entries",!,"3. Prompts with the field name.  Does not automatically enter data.",!!

 +2        QUIT