source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPV.m@ 1525

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1LRCAPV ;DALOI/FHS - DETERMINE WKLD CODE AND STUFF INTO 68 ;2/19/91 11:45
2 ;;5.2;LAB SERVICE;**232**;Sep 27, 1994
3EN ;from LRVER4,LRVR4,LRMIEDZ,LRMIV,LROE,LRVER
4 K LRCSQ,LRCSQQ S LREND=0 Q:'$P(LRPARAM,U,14)!('$D(LRAA)) Q:'$P($G(^LRO(68,+LRAA,0)),U,16) S LRCSQQ=+$P(^(0),U,20)
5 I $D(LRCDEF),$D(LRCDEF0) W !!?7,"Currently you are using ( ",$P(LRCDEF0,U)_" ) Suffix ["_$P(LRCDEF0,U,2)_"]"
6 W !! K DIC S:$G(LRLL) DIC("B")=$S($G(^LRO(68.2,+LRLL,"SUF")):$P(^(0),U),1:"")
7 S LREND=0,DIC="^LRO(68.2,",DIC(0)="AQEM",DIC("A")="Work Load Area: ",DIC("S")="I $D(^(""SUF"")),+^(""SUF"")" D ^DIC S:Y<1 LREND=1 K DIC
8EN1 Q:$G(LREND)
9 N LRSUFIEN,I
10 S LRSUF0=^LRO(68.2,+Y,"SUF") D
11 . S LRSUFIEN=$O(^LAB(64.2,"C",$P(LRSUF0,U,3)_" ",0))
12 . Q:'LRSUFIEN S $P(LRUSUFO,U)=LRSUFIEN
13 S LRCDEF0=$S($D(^LAB(64.2,+LRSUF0,0)):$P(^(0),U,1,18),1:0) S:LRCDEF0=0 LREND=1 G:$G(LREND) STOP S LRCDEF0(1)=$P(^(0),U,19),LRCDEF=$P($P(LRCDEF0,U,2),".",2)
14 S I=0 F S I=$O(^LRO(68.2,+Y,4,I)) Q:I<.5 S LRCDEF(I)=""
15 I '$P(LRSUF0,U,7) S $P(LRSUF0,U,7)=+LRAA,LRLD=$S($L($P($G(^LRO(68,LRAA,0)),U,19)):$P($G(^LRO(68,LRAA,0)),U,19),1:"CP"),LRCSQQ=+$P(^(0),U,20) K DIC
16 S:'$P(LRSUF0,U,8) $P(LRSUFO,U,8)=+LRAA
17 S LRCAPMS=$P(LRSUF0,U,7)_U_$S($P(LRSUF0,U,8):$P(LRSUF0,U,8),1:$P(LRSUF0,U,7)),LRCAPWA=$S($P(LRSUF0,U,9):$P(LRSUF0,U,9),1:$P(LRSUF0,U,8)),LRCAPMS=LRCAPMS_U_LRCAPWA
18 I $G(LRCSQQ) S LRCSQ=$H,^XTMP("LRCAP",LRCSQ,DUZ)=""
19 Q
20AUTO ;from LRVR
21 Q:'$P(LRPARAM,U,14)!('$P($G(^LRO(68,+LRAA,0)),U,16)) S LRX=$G(^LRO(68,LRAA,0)),LRLD=$S($L($P(LRX,U,19)):$P(LRX,U,19),1:"CP") K LRX
22 I $D(^LRO(68.2,LRLL,"SUF")),+^("SUF") S LRCDEF0=^("SUF"),LRP=+LRCDEF0,LRCDEF0=$S($D(^LAB(64.2,LRP,0)):^(0),1:0) I LRCDEF0 S LRCDEF=$P(LRCDEF0,U,2),LRCDEF0(1)=$P(^(0),U,19)
23 G EN
24 Q
25STD ;from LRVER,LRVER4,LRVR,LRVR4,LRVRW,LAMIAUTO,LRMIEDZ
26 I $G(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) K ^XTMP("LRCAP",LRCSQ) G STDQ
27 G:'$G(LRCSQ) STDQ
28 S LRCSQQ=+$P($G(^LRO(68,+$G(LRAA),0)),U,20) I 'LRCSQQ,$G(LRCSQ) K ^XTMP("LRCAP",LRCSQ) G STDQ
29 I '$P($G(LRPARAM),U,14) K:$G(LRCSQ) ^XTMP("LRCAP",LRCSQ) G STDQ
30 W !!?10,"Wish to enter STD/QC/REPS " S %=2 D YN^DICN G:%=0 STD I %'=1 G STDQ
31 S (LRREP,LRQC,LRSTD)=0
32ST R !!?10,"Number of standards this run ",LRSTD:DTIME G:'$T!(LRSTD="^") SQR G:$G(LRSTD)="^QC" @("QC") G:$G(LRSTD)="^REP" @("REP") I $G(LRSTD)'=0,$G(LRSTD)'="",'+$G(LRSTD) D MSG G ST
33QC R !!?10,"Number of QC this Run ",LRQC:DTIME G:'$T!($G(LRQC)="^") SQR G:$G(LRQC)="^STD" @("ST") G:$G(LRQC)="^REP" @("REP") I $G(LRQC)'=0,$G(LRQC)'="",'+$G(LRQC) D MSG G QC
34REP R !!,?10,"Number of Repeats ",LRREP:DTIME G:'$T!($G(LRREP)="^") SQR G:$G(LRREP)="^QC" @("QC") G:$G(LRREP)="^STD" @("ST") I LRREP'=0,LRREP'="",'+LRREP D MSG G REP
35SQR K LRTAGE,LRSUF0 I 'LRSTD&('LRQC)&('LRREP) G STDQ
36 S LRDUZ=DUZ,ZTSAVE("LRDUZ")="",ZTSAVE("LRSTD")="",ZTSAVE("LRQC")="",ZTSAVE("DT")="",ZTSAVE("LRREP")="",ZTSAVE("LRCSQ")="",ZTSAVE("U")="",^XTMP("LRCAP",LRCSQ,DUZ)=LRSTD_"STD^"_LRQC_"QC^"_LRREP_"REPS^"
37 S ZTRTN="QC^LRCAPPH",ZTIO="",ZTDTH=$H,ZTDESC="TALLY LAB QC/STD/REPS " D ^%ZTLOAD
38SQR1 S ZTRTN="LRCAPV2",ZTDTH=$H,ZTDESC="LAB WORKLOAD PROGRAM",ZTIO="" D ^%ZTLOAD
39 K LRCSQ,LRCSQQ,LRSTD,LRQC,LRREP,LRDUZ
40 Q
41STDQ K:$D(LRCSQ) ^XTMP("LRCAP",LRCSQ,DUZ) K LRCSQ,LRCSQQ
42ANN I $P($G(LRPARAM),U,14) S ZTIO="",ZTRTN="LRCAPV2",ZTDTH=$H,ZTDESC="LAB WORKLOAD PROGRAM" D ^%ZTLOAD
43 K LRCSQ,LRCSQQ,LRSTD,LRQC,LRREP Q
44CON ;
45 N J
46 S J=0 F S J=$O(^LAB(60,+X,2,J)) Q:J<1 I $D(^(J,0)) S NODE=+^(0) I '$D(LRTEST(NODE)) S LRTEST(NODE)="",LRNT(LRNT)=NODE S:'$O(^LAB(60,NODE,2,0)) LRNT=LRNT+1
47 Q
48ENCON ;
49 N I
50 I '$O(^LAB(60,+X,2,0)) S LRNT=1 Q
51 K LRTEST,LRNT S LRNT=0 D CON S I=0 F S I=$O(LRNT(I)) Q:I="" S X=LRNT(I) D CON
52 Q
53MSG W !!?10,"Enter a Number - Press Return or '^' to Stop " Q
54STOP ;
55 S LREND=1 K LRCDEF,LRCDEF0,DIC,LRSUF0,LRCDEF,LRCDEF0X,LRLD,LRCAPMS,LRCAPWA,LRCSQ
56 Q
Note: See TracBrowser for help on using the repository browser.