source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPV1S.m@ 1789

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1LRCAPV1S ;SLC/FHS-SET WKLD CODE INTO LRO(68 PART 2 ; 12/3/1997
2 ;;5.2;LAB SERVICE;**42,153,201,221**;Sep 27, 1994
3SET ; From LRCAPV1
4 Q:'$D(^LRO(68,+LRAA,1,LRAD,1,LRAN,0))#2
5 I '$D(LRTIME) S LRTIME=$$NOW^XLFDT
6 I '$P(LRTIME,".",2) S LRTIME=$$NOW^XLFDT
7 I '$D(^LRO(68,+LRAA,1,LRAD,1,LRAN,4,LRT,0))#2 S:$G(LRALERT) LRURGW=LRALERT D
8 . S ^LRO(68,+LRAA,1,LRAD,1,LRAN,4,LRT,0)=LRT_U_(50+$G(LRURGW))_U_U_DUZ_U_LRTIME_"^^^"_LRCDEF_U_$P($G(LRT("P")),U)
9 . S $P(^LRO(68,+LRAA,1,LRAD,1,LRAN,4,0),U,3)=LRT,$P(^(0),U,4)=1+$P(^(0),U,4),^LRO(68,+LRAA,1,LRAD,1,LRAN,4,"B",LRT,LRT)=""
10 S:'$P(^LRO(68,+LRAA,1,LRAD,1,LRAN,4,LRT,0),U,8) $P(^(0),U,8)=$G(LRCDEF)
11 S:'$D(^LRO(68,+LRAA,1,LRAD,1,LRAN,4,LRT,1,0))#2 ^(0)="^68.14P^" S NODE0=^(0),NODE=LRP_U_"^^^^"_LRTIME_U_DUZ_U_DUZ(2)_U_$S($G(LRCAPMS):LRCAPMS,1:+LRAA)_U
12 I '$D(^LRO(68,+LRAA,1,LRAD,1,LRAN,4,LRT,1,LRP,0)) S $P(NODE0,U,3)=LRP,$P(NODE0,U,4)=1+$P(NODE0,U,4),^LRO(68,+LRAA,1,LRAD,1,LRAN,4,LRT,1,0)=NODE0,^(LRP,0)=NODE
13 S X=^LRO(68,+LRAA,1,LRAD,1,LRAN,4,LRT,1,LRP,0) I '$D(LRADD),$P(X,U,2) Q
14 I $D(LRADD) S:'$P(X,U,3) $P(X,U,2)=LRCNT+$P(X,U,2) S:$P(X,U,3) $P(X,U,2)=LRCNT,$P(X,U,3)=0 S ^LRO(68,+LRAA,1,LRAD,1,LRAN,4,LRT,1,LRP,0)=X
15 I '$D(LRADD),'$P(X,U,3) S $P(X,U,2)=LRCNT,^LRO(68,+LRAA,1,LRAD,1,LRAN,4,LRT,1,LRP,0)=X
16 I $G(LRCSQ),$G(LRCSQQ) D
17 . S ^XTMP("LRCAP",LRCSQ,DUZ,0)=$$HTFM^XLFDT($H+30,1)_U_DT_U_"Lab Control workload count"_U_$G(DUZ)
18 . S ^XTMP("LRCAP",LRCSQ,DUZ,LRP)=""
19 Q
Note: See TracBrowser for help on using the repository browser.