source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPCWK.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1LRAPCWK ;AVAMC/REG - STUFF CYTOPATH WORKLOAD ;8/3/94 08:05
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3ASK W ! S %DT("A")="Date/time Specimen(s) Processed: " D W^LRAPWU I LRK<1 W $C(7),!!,"Processing workload not recorded. Is this what you want " S %=2 D YN^LRU Q:%<2 G ASK
4 K A F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,.1,A)) Q:'A S A(A)=$P(^(A,0),"^",2)
5 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) ^(0)="^68.04PA^^" F A=0:0 S A=$O(A(A)) Q:'A S LRT=A(A) D:LRT STF,R
6 Q
7R F C=0:0 S C=$O(^LAB(60,LRT,9.1,C)) Q:'C D CAP
8 I $G(LRW("S")) S C=LRW("S") D CAP
9 D SET F LRX=0:0 S LRX=$O(^LAB(60,LRT,2,LRX)) Q:'LRX S X(1)=+^(LRX,0),X(2)=$P($G(^LAB(60,X(1),0)),"^",19) I X(2),$D(^LAB(62.07,X(2),0)) S Y=$P(^(0),"^") D B
10 Q
11CAP I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0)) S ^(0)=C_"^1^0^0^^"_LRRC_"^"_DUZ_"^"_DUZ(2)_"^"_LRAA_"^"_LRAA_"^"_LRAA,X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0),^(0)=$P(X,"^",1,2)_"^"_C_"^"_($P(X,"^",4)+1) Q
12 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,C,0),$P(X,"^",2)=$S($P(X,"^",3):1,1:$P(X,"^",2)+1),$P(X,"^",3)=0,^(0)=X Q
13 ;
14B Q:'$D(LRZ(Y)) S LRO=LRT,LRO(1)=LRRC,LRRC=LRK,LRT=X(1) D STF F C=0:0 S C=$O(^LAB(60,LRT,9,C)) Q:'C D CAP
15 D SET S LRT=LRO,LRRC=LRO(1),E=+LRZ(Y),Y(2)=$S($P(LRZ(Y),"^",4)]"":$P(LRZ(Y),"^",4),1:$E(Y,1,9)) S:'$D(^LR(LRDFN,LRSS,LRI,.1,A,E,0)) ^(0)="^"_$P(LRZ(Y),"^",2)_"^^" S B=$P(^(0),"^",3)+1
16G I $D(^LR(LRDFN,LRSS,LRI,.1,A,E,B,0)) S B=B+1 G G
17 S F=^LR(LRDFN,LRSS,LRI,.1,A,E,0),^(0)=$P(F,"^",1,2)_"^"_B_"^"_($P(F,"^",4)+1),^(B,0)=Y(2)
18 S:'$D(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,0)) ^(0)="^"_$P(LRZ(Y),"^",3)_"^^"
19 F C=0:0 S C=$O(^LAB(60,X(1),2,C)) Q:'C S C(1)=^(C,0) D S
20 Q
21S I '$D(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,+C(1),0)) S ^(0)=$P(C(1),"^",1,2),F=^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,0),^(0)=$P(F,"^",1,2)_"^"_+C(1)_"^"_($P(F,"^",4)+1) Q
22 S F=^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,+C(1),0),$P(F,"^",2)=$P(F,"^",2)+$P(C(1),"^",2),^(0)=F Q
23 ;
24STF I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0)) S ^(0)=LRT_"^50^^"_DUZ_"^"_LRRC,X=^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),^(0)=$P(X,"^",1,2)_"^"_LRT_"^"_($P(X,"^",4)+1)
25 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,1,0)) ^(0)="^68.14P^^" Q
26SET S ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_LRT)="" Q
27 ;
28CK I '$O(^LR(LRDFN,LRSS,LRI,.1,0)) S Y=1 W !!,"No SPECIMEN entered." G OUT
29 K A S A=0 F B=1:1 S A=$O(^LR(LRDFN,LRSS,LRI,.1,A)) Q:'A S X=$P(^(A,0),"^",2) S:X'=+X X=0 I '$D(^LAB(60,X,0)) S $P(^LR(LRDFN,LRSS,LRI,.1,A,0),U,2)="" W:B=1 ! W !,"WORKLOAD PROFILE NOT ENTERED FOR ",$P(^(0),U) S Y=1
30OUT Q
31C ;from LRAPDA
32 S LRK=1,C=0 F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,.1,A)) Q:'A!(C) F B=0:0 S B=$O(^(A,B)) Q:'B S C=1
33 Q:C D EN^LRAPST,ASK Q
Note: See TracBrowser for help on using the repository browser.