source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPVM.m@ 738

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

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1LRCAPVM ;DALOI/FHS - ADD WKLD CODES FOR MICRO VERIFICATION ;5/15/00
2 ;;5.2;LAB SERVICE;**49,163,263**;Sep 27, 1994
3EN ;
4 N LRORG
5 Q:'$P(LRPARAM,U,14)!('$P($G(^LRO(68,LRAA,0)),U,16)) S LREND=0
6 I $D(LAMIAUTO),$D(LRINST) S LRTS=$S(+$P(^LAB(62.4,LRINST,0),U,16):$P(^(0),U,16),1:LRTS),LRORG=0 I LRTS D
7 . F S LRORG=$O(^LAH(LRLL,1,LRIFN,3,LRORG)) K LRADD Q:LRORG<1 I $D(^(LRORG,0))#2 S LRGB1=+^(0),GLB="^LAB(61.2,LRGB1,9,A)",LRADD="" D ETIOL^LRCAPV1
8 Q:$G(LRMIMASS)
9 K GLB F W !!?10,"(D)isplay (A)dd Work Load " R X:DTIME S X=$E(X) S:'$T!(X=U)!(X="") LREND=1 Q:X="A"!(LREND) D:X="D" DIS^LRCAPU
10 G END:LREND
11 S X1="" S LRTIME=$$NOW^LRAFUNC1,LRADD=""
12SEL ;
13 K DIC,DA S DIC("A")="Which Test ",DIC(0)="AEQNMZ",DIC="^LRO(68,"_LRAA_",1,"_LRAD_",1,"_LRAN_",4,"
14 S DA(1)=LRAN,DA(2)=LRAD,DA(3)=LRAA,X1="" F D ^DIC Q:Y<1 S:$L(X1) X1=X1_","_+Y I '$L(X1) S X1=+Y
15 G:'$L(X1) END S X=X1 D RANGE^LRWU2 I '$L(X9) W !,"NOTHING SELECTED " G END
16 K DIC S LREND=0,LRSTAR=1,X9=X9_"Q:LREND D LOAD" X X9 S LREND=0
17 G EN
18LOAD ;
19 Q:'$D(^LAB(60,T1,0))
20 I '$P(^LAB(60,T1,0),U,14) W !!?7," ** NO EDIT TEMPLATE FOR ",$P(^(0),U),! Q
21CODE S LREC=$P(^LAB(60,T1,0),U,14) I '$D(^LAB(62.07,LREC,0)) W !,"ERROR IN ",$P(^LAB(60,T1,0),U) Q
22 I '$O(^LAB(62.07,LREC,9,0)) W !!?5,"NO CODE DEFINED FOR THE TEST ",!,$C(7) Q
23 W !!?10,"Additional Work load for "_$P(^LAB(60,T1,0),U),!
24 S LRT=T1,DIC="^LAB(62.07,"_LREC_",9,",DIC(0)="AEZMNQ"
25 F G:LREND MORE D ^DIC Q:Y<1 S:X=U LREND=1 Q:LREND S LRP=+Y,LRCODE=$P(Y,U,2),LRCNT=$S($P(Y(0),U,3):$P(Y(0),U,3),1:1) D CNT
26 K LRSTAR1,LRCNTD
27MORE S LREND=0
28 Q
29CNT ;
30 D Q:$D(DIRUT)!($D(DTOUT))!($D(DUOUT))
31 . N DIR
32 . S DIR(0)="NO^0:25:0",DIR("A")=" MULTIPLY BY "
33 . I $G(LRCNT),$G(LRCNT)<26 S DIR("B")=+$G(LRCNT)
34 . S DIR("?")=$$CJ^XLFSTR("to be used for this procedure.",IOM)
35 . S DIR("?",1)=$$CJ^XLFSTR("Enter the WKLD CODE weight multiplier,",IOM)
36 . S DIR("?",2)=$$CJ^XLFSTR("enter a number between 1 - 25",IOM)
37 . D ^DIR
38 S LRCNT=+Y
39 I LRCNT<1 W !?5,"No workload added ",! Q
40CK Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT)) S:'$D(^(LRT,1,0)) ^(0)="^68.14P^" S NODE0=^(0),LRADD="" D STUFE^LRCAPV1 K LRADD
41 Q
42QUE ;S X="?" D ^DIC G RD
43END ;
44 K DIC,T1,LRSTAR,LRADD S LREND=0
45 Q
Note: See TracBrowser for help on using the repository browser.