[613] | 1 | LRMISTF ;SLC/CJS/BA - MASS DATA ENTRY INTO FILE 63.05 ;4/24/89 14:40 ;
|
---|
| 2 | ;;5.2;LAB SERVICE;**153**;Sep 27, 1994
|
---|
| 3 | ;from option LRMISTUF
|
---|
| 4 | ACCESS I '$D(^XUSEC("LRVERIFY",DUZ)) W !,"You're not cleared for this option. You must have the LRVERIFY Key." Q
|
---|
| 5 | 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
|
---|
| 6 | S LRMIMASS=1
|
---|
| 7 | D ASK
|
---|
| 8 | I $D(LRCSQ),$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) D STD^LRCAPV
|
---|
| 9 | END D ANN^LRMIEDZ,^LRGVK
|
---|
| 10 | 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
|
---|
| 11 | K LRMIMASS
|
---|
| 12 | Q
|
---|
| 13 | ASK D LRAA^LRMIUT Q:LRAA<1 S LRSS=$P(^LRO(68,LRAA,0),U,2)
|
---|
| 14 | I LRSS="" W !?5,"Accession Area LR SUBSCRIPT is misssing.",! Q
|
---|
| 15 | I $P(LRPARAM,U,14) D ^LRCAPV G:LREND ANN^LRMIEDZ
|
---|
| 16 | 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"
|
---|
| 17 | 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
|
---|
| 18 | S LRECODE=$P(^LAB(60,LRTEST,0),U,14),LRECODE=$S($D(^LAB(62.07,LRECODE,.1)):^(.1),1:"")
|
---|
| 19 | 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
|
---|
| 20 | I 'LRSBCNT W "Test does not have an appropriate entry in the EDIT CODE" Q
|
---|
| 21 | F I=0:0 R !,"Preliminary or Final: ",X:DTIME Q:'$T!(X[U)!(X="P")!(X="F") W !,"Enter ""P"" or ""F""."
|
---|
| 22 | Q:'$T!(X[U) S LRPF=X
|
---|
| 23 | I LRSBCNT=1 S H9=$O(LRSB(0)),LRSB=Z(H9),LRMF=$P(^DD(63.05,H9,0),U) W !,LRMF K DIC
|
---|
| 24 | 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)
|
---|
| 25 | 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
|
---|
| 26 | Q:X=""!(X[U) S LRMODE=X
|
---|
| 27 | 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:"")
|
---|
| 28 | D ^LRMISTF1
|
---|
| 29 | Q
|
---|
| 30 | INFO W !,"Enter a number between 1 and 3.",!,"1. Automatically enters the result you specify. You cannot change the entries."
|
---|
| 31 | 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.",!!
|
---|
| 32 | Q
|
---|