- LRCAPVM ;DALOI/FHS - ADD WKLD CODES FOR MICRO VERIFICATION ;5/15/00
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**49,163,263**;Sep 27, 1994
- EN ;
- N LRORG
- Q:'$P(LRPARAM,U,14)!('$P($G(^LRO(68,LRAA,0)),U,16)) S LREND=0
- 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
- . 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
- Q:$G(LRMIMASS)
- 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
- G END:LREND
- S X1="" S LRTIME=$$NOW^LRAFUNC1,LRADD=""
- SEL ;
- K DIC,DA S DIC("A")="Which Test ",DIC(0)="AEQNMZ",DIC="^LRO(68,"_LRAA_",1,"_LRAD_",1,"_LRAN_",4,"
- 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
- G:'$L(X1) END S X=X1 D RANGE^LRWU2 I '$L(X9) W !,"NOTHING SELECTED " G END
- K DIC S LREND=0,LRSTAR=1,X9=X9_"Q:LREND D LOAD" X X9 S LREND=0
- G EN
- LOAD ;
- Q:'$D(^LAB(60,T1,0))
- I '$P(^LAB(60,T1,0),U,14) W !!?7," ** NO EDIT TEMPLATE FOR ",$P(^(0),U),! Q
- CODE 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
- I '$O(^LAB(62.07,LREC,9,0)) W !!?5,"NO CODE DEFINED FOR THE TEST ",!,$C(7) Q
- W !!?10,"Additional Work load for "_$P(^LAB(60,T1,0),U),!
- S LRT=T1,DIC="^LAB(62.07,"_LREC_",9,",DIC(0)="AEZMNQ"
- 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
- K LRSTAR1,LRCNTD
- MORE S LREND=0
- Q
- CNT ;
- D Q:$D(DIRUT)!($D(DTOUT))!($D(DUOUT))
- . N DIR
- . S DIR(0)="NO^0:25:0",DIR("A")=" MULTIPLY BY "
- . I $G(LRCNT),$G(LRCNT)<26 S DIR("B")=+$G(LRCNT)
- . S DIR("?")=$$CJ^XLFSTR("to be used for this procedure.",IOM)
- . S DIR("?",1)=$$CJ^XLFSTR("Enter the WKLD CODE weight multiplier,",IOM)
- . S DIR("?",2)=$$CJ^XLFSTR("enter a number between 1 - 25",IOM)
- . D ^DIR
- S LRCNT=+Y
- I LRCNT<1 W !?5,"No workload added ",! Q
- CK 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
- Q
- QUE ;S X="?" D ^DIC G RD
- END ;
- K DIC,T1,LRSTAR,LRADD S LREND=0
- Q
- LRCAPVM ;DALOI/FHS - ADD WKLD CODES FOR MICRO VERIFICATION ;5/15/00
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**49,163,263**;Sep 27, 1994
- EN ;
- +1 NEW LRORG
- +2 IF '$PIECE(LRPARAM,U,14)!('$PIECE($GET(^LRO(68,LRAA,0)),U,16))
- QUIT
- SET LREND=0
- +3 IF $DATA(LAMIAUTO)
- IF $DATA(LRINST)
- SET LRTS=$SELECT(+$PIECE(^LAB(62.4,LRINST,0),U,16):$PIECE(^(0),U,16),1:LRTS)
- SET LRORG=0
- IF LRTS
- Begin DoDot:1
- +4 FOR
- SET LRORG=$ORDER(^LAH(LRLL,1,LRIFN,3,LRORG))
- KILL LRADD
- IF LRORG<1
- QUIT
- IF $DATA(^(LRORG,0))#2
- SET LRGB1=+^(0)
- SET GLB="^LAB(61.2,LRGB1,9,A)"
- SET LRADD=""
- DO ETIOL^LRCAPV1
- End DoDot:1
- +5 IF $GET(LRMIMASS)
- QUIT
- +6 KILL GLB
- FOR
- WRITE !!?10,"(D)isplay (A)dd Work Load "
- READ X:DTIME
- SET X=$EXTRACT(X)
- IF '$TEST!(X=U)!(X="")
- SET LREND=1
- IF X="A"!(LREND)
- QUIT
- IF X="D"
- DO DIS^LRCAPU
- +7 IF LREND
- GOTO END
- +8 SET X1=""
- SET LRTIME=$$NOW^LRAFUNC1
- SET LRADD=""
- SEL ;
- +1 KILL DIC,DA
- SET DIC("A")="Which Test "
- SET DIC(0)="AEQNMZ"
- SET DIC="^LRO(68,"_LRAA_",1,"_LRAD_",1,"_LRAN_",4,"
- +2 SET DA(1)=LRAN
- SET DA(2)=LRAD
- SET DA(3)=LRAA
- SET X1=""
- FOR
- DO ^DIC
- IF Y<1
- QUIT
- IF $LENGTH(X1)
- SET X1=X1_","_+Y
- IF '$LENGTH(X1)
- SET X1=+Y
- +3 IF '$LENGTH(X1)
- GOTO END
- SET X=X1
- DO RANGE^LRWU2
- IF '$LENGTH(X9)
- WRITE !,"NOTHING SELECTED "
- GOTO END
- +4 KILL DIC
- SET LREND=0
- SET LRSTAR=1
- SET X9=X9_"Q:LREND D LOAD"
- XECUTE X9
- SET LREND=0
- +5 GOTO EN
- LOAD ;
- +1 IF '$DATA(^LAB(60,T1,0))
- QUIT
- +2 IF '$PIECE(^LAB(60,T1,0),U,14)
- WRITE !!?7," ** NO EDIT TEMPLATE FOR ",$PIECE(^(0),U),!
- QUIT
- CODE SET LREC=$PIECE(^LAB(60,T1,0),U,14)
- IF '$DATA(^LAB(62.07,LREC,0))
- WRITE !,"ERROR IN ",$PIECE(^LAB(60,T1,0),U)
- QUIT
- +1 IF '$ORDER(^LAB(62.07,LREC,9,0))
- WRITE !!?5,"NO CODE DEFINED FOR THE TEST ",!,$CHAR(7)
- QUIT
- +2 WRITE !!?10,"Additional Work load for "_$PIECE(^LAB(60,T1,0),U),!
- +3 SET LRT=T1
- SET DIC="^LAB(62.07,"_LREC_",9,"
- SET DIC(0)="AEZMNQ"
- +4 FOR
- IF LREND
- GOTO MORE
- DO ^DIC
- IF Y<1
- QUIT
- IF X=U
- SET LREND=1
- IF LREND
- QUIT
- SET LRP=+Y
- SET LRCODE=$PIECE(Y,U,2)
- SET LRCNT=$SELECT($PIECE(Y(0),U,3):$PIECE(Y(0),U,3),1:1)
- DO CNT
- +5 KILL LRSTAR1,LRCNTD
- MORE SET LREND=0
- +1 QUIT
- CNT ;
- +1 Begin DoDot:1
- +2 NEW DIR
- +3 SET DIR(0)="NO^0:25:0"
- SET DIR("A")=" MULTIPLY BY "
- +4 IF $GET(LRCNT)
- IF $GET(LRCNT)<26
- SET DIR("B")=+$GET(LRCNT)
- +5 SET DIR("?")=$$CJ^XLFSTR("to be used for this procedure.",IOM)
- +6 SET DIR("?",1)=$$CJ^XLFSTR("Enter the WKLD CODE weight multiplier,",IOM)
- +7 SET DIR("?",2)=$$CJ^XLFSTR("enter a number between 1 - 25",IOM)
- +8 DO ^DIR
- End DoDot:1
- IF $DATA(DIRUT)!($DATA(DTOUT))!($DATA(DUOUT))
- QUIT
- +9 SET LRCNT=+Y
- +10 IF LRCNT<1
- WRITE !?5,"No workload added ",!
- QUIT
- CK IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT))
- QUIT
- IF '$DATA(^(LRT,1,0))
- SET ^(0)="^68.14P^"
- SET NODE0=^(0)
- SET LRADD=""
- DO STUFE^LRCAPV1
- KILL LRADD
- +1 QUIT
- QUE ;S X="?" D ^DIC G RD
- END ;
- +1 KILL DIC,T1,LRSTAR,LRADD
- SET LREND=0
- +2 QUIT
