| 1 | LRMIVER ;SLC/CJS/BA - MICROBIOLOGY CHART COPY APPROVAL ;4/24/89 14:42 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | ;from option LRMIVER
|
|---|
| 4 | ACCESS D ^LRPARAM I $S('$D(LRLABKY):1,'$P(LRLABKY,U):1,1:0) W "You must have the LRVERIFY key to use this option." Q
|
|---|
| 5 | BEGIN S X="N",%DT="T" D ^%DT S LRNT=+Y,LRVT="VS" S LRDAT=LRDT0 D LRAA^LRMIUT I LRAA'<1 D ASK
|
|---|
| 6 | END K ^TMP($J),%,%DT,AGE,D,DFN,DOB,DTOUT,DUOUT,I,II,J,K,LAST,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDAT,LRDFN,LRDONE,LRDPF,LREND,LRIDT,LRVT
|
|---|
| 7 | K LRLCNT,LRLLT,LRLST,LRLTR,LRNT,LRONESPC,LRONETST,LRPG,LRSB,LRSET,LRST,LRSTAR,LRTK,LRVLOC,LRWLSAVE,LRWRD,LRWRDVEW,LRYRL,PNM,POP,SEX,SSN,X,Y
|
|---|
| 8 | Q
|
|---|
| 9 | ASK F I=0:0 W !,"Use previous list" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
|
|---|
| 10 | I %=1 D LIST,^LRMIVER1 Q
|
|---|
| 11 | I %=2 D BUILD
|
|---|
| 12 | Q
|
|---|
| 13 | LIST W !,"Approving the following:",! S LRAD=0 F I=0:0 S LRAD=+$O(^LRO(68,"AVS",LRAA,LRAD)) Q:LRAD<1 D LIS1
|
|---|
| 14 | Q
|
|---|
| 15 | LIS1 S LRAN=0 F I=0:0 S LRAN=+$O(^LRO(68,"AVS",LRAA,LRAD,LRAN)) Q:LRAN<1 S LRDFN=+^(LRAN),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,$J(LRAN,6),?8,PNM,?35," ",SSN
|
|---|
| 16 | Q
|
|---|
| 17 | BUILD K ^LRO(68,"AVS",LRAA) S %DT="AEQ",%DT("A")="Start Date: " D ^%DT K %DT Q:Y<0 S LRSTAR=Y D D^LRU S LRST=Y
|
|---|
| 18 | S %DT="AEQ",%DT("A")="End Date: " D ^%DT K %DT Q:Y<0 S LAST=Y D D^LRU S LRLST=Y Q:Y<0 I LRSTAR>LAST S X=LRSTAR,LRSTAR=LAST,LAST=X,X=LRST,LRST=LRLST,LRLST=X
|
|---|
| 19 | S Y=LRSTAR D D^LRU S LRST=Y,Y=LAST D D^LRU S LRLST=Y,LRAAT=$P(^LRO(68,LRAA,0),U,3)
|
|---|
| 20 | S LRAD=$S(LRAAT="M":$E(LRSTAR,1,3)-2_$E(LRSTAR,4,5)_"00",1:$E(LRSTAR,1,3)-2_"0000"),LRYRL=$S(LRAAT="M":$E(LAST,1,5)_"00",1:$E(LAST,1,3)_"0000"),LAST=LAST\1+.99
|
|---|
| 21 | F I=0:0 S LRAD=+$O(^LRO(68,LRAA,1,LRAD)) Q:LRAD<1!(LRAD>LRYRL) D AC
|
|---|
| 22 | D ^LRMIVER1
|
|---|
| 23 | Q
|
|---|
| 24 | AC S LRTK=LRSTAR-1 F I=0:0 S LRTK=+$O(^LRO(68,LRAA,1,LRAD,1,"AD",LRTK)) Q:LRTK<1!(LRTK>LAST) D AC1
|
|---|
| 25 | Q
|
|---|
| 26 | AC1 S LRAN=0 F I=0:0 S LRAN=+$O(^LRO(68,LRAA,1,LRAD,1,"AD",LRTK,LRAN)) Q:LRAN<1 I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D OK
|
|---|
| 27 | Q
|
|---|
| 28 | OK Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) S LRDONE=$P(^(3),U,4) Q:LRDONE
|
|---|
| 29 | S LRIDT=9999999-^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRDFN=+^(0),LRSET=0 F II=1,5,8,11,16 D FINAL
|
|---|
| 30 | W:'LRSET "." I LRSET S ^LRO(68,"AVS",LRAA,LRAD,LRAN)=LRDFN_U_LRIDT S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,$J(LRAN,6),?8,PNM,?35," ",SSN,?80
|
|---|
| 31 | Q
|
|---|
| 32 | FINAL I $D(^LR(LRDFN,"MI",LRIDT,II)),+^(II),$P(^(II),U,2)="F" S LRSET=1
|
|---|
| 33 | Q
|
|---|
