147 lines
4.8 KiB
Mathematica
147 lines
4.8 KiB
Mathematica
LRCAPD ;SLC/AM/DALOI/FHS - WORKLOAD CODE LIST REPORT;1/16/91 15:34
|
|
;;5.2;LAB SERVICE;**105,163,153,278**;Sep 27, 1994
|
|
EN ;
|
|
W !!?5,"I will produce a list of WKLD codes in your file 60 "
|
|
K %ZIS,DX S %ZIS="QN",%ZIS("A")="Printer Name " D ^%ZIS G:POP CLEAN
|
|
I IO'=IO(0)!($D(IO("Q"))) S ZTRTN="DQ^LRCAPD",ZTIO=ION,ZTDESC="PRINT WKLD CODES FROM ^LAB(60 " W !!?10,"Report Queued to "_ION,! D ^%ZTLOAD,^%ZISC G CLEAN
|
|
DQ ;
|
|
D START
|
|
D CLEAN
|
|
Q
|
|
START ;
|
|
K ^TMP("LR",$J,"CAP"),^TMP("LR",$J,"CAPN")
|
|
S (LRTS,LREND,LRPAG)=0,$P(LRLINE,"_",(IOM+1))=""
|
|
;test list
|
|
W:$E(IOST,1,2)="C-" @IOF
|
|
D HEAD
|
|
S LRTSN=""
|
|
F S LRTSN=$O(^LAB(60,"B",LRTSN)) Q:(LRTSN="")!($G(LREND)) D
|
|
.S LRTS=$O(^LAB(60,"B",LRTSN,0))
|
|
.I LRTS>0,'$G(^LAB(60,"B",LRTSN,LRTS)) D PRNT
|
|
Q:$G(LREND)
|
|
D PAUSE
|
|
;CAP code list
|
|
W @IOF
|
|
D HEAD2
|
|
S I=$O(^TMP("LR",$J,"CAP",0))
|
|
I '$L(I) W !!?5,"NONE",! S LREND=1
|
|
E D
|
|
.S DIC="^LAM(",(DR,LRI)=0
|
|
.F S LRI=$O(^TMP("LR",$J,"CAP",LRI)) Q:(LRI="")!($G(LREND)) S DA=^(LRI) D
|
|
..I $Y>(IOSL-8) D
|
|
...D PAUSE Q:$G(LREND)
|
|
...W @IOF
|
|
...D HEAD2
|
|
..Q:$G(LREND)
|
|
..S S=$Y D EN^DIQ
|
|
Q:$G(LREND)
|
|
NLTPRT W !! W:$E(IOST,12)="P-" @IOF I $O(^TMP("LR",$J,"CAPN",0))'="" D
|
|
. D HEAD3
|
|
. S DIC="^LAM(",(DR,LRI)=0
|
|
. F S LRI=$O(^TMP("LR",$J,"CAPN",LRI)) Q:(LRI="")!($G(LREND)) S DA=^(LRI) D
|
|
.. I $Y>(IOSL-8) D Q:$G(LREND)
|
|
... D PAUSE Q:$G(LREND)
|
|
... W @IOF
|
|
... D HEAD3
|
|
.. Q:$G(LREND)
|
|
.. S S=$Y D EN^DIQ
|
|
Q:$G(LREND)
|
|
D PAUSE
|
|
Q
|
|
PRNT ;
|
|
Q:$G(LREND)
|
|
I $Y>(IOSL-8) D Q:$G(LREND)
|
|
. D PAUSE Q:$G(LREND)
|
|
. W @IOF D HEAD
|
|
I '($D(^LAB(60,LRTS,0))#2) Q
|
|
S (NAME1,NAME)=""
|
|
I $G(^LAB(60,LRTS,64)) S LRCC=+^(64) D
|
|
. D NAME W ?5,"National VA Lab Code: ",$P($G(^LAM(+LRCC,0)),U,2)_" "_$P(^(0),U),!
|
|
. I $O(^LAM(+LRCC,4,0)) W ?15 D W !
|
|
. . S N=0 F S N=$O(^LAM(+LRCC,4,"B",N)) Q:N=""!($G(LREND)) W "[ CPT ",N," ] "
|
|
. G ERR:'$D(^LAM(LRCC,0)) S ^TMP("LR",$J,"CAPN",$P(^(0),U))=LRCC
|
|
I $P($G(^LAB(60,LRTS,64)),U,2) S LRCC=$P(^(64),U,2) D
|
|
. D NAME W ?5,"Result NLT Code: ",$P($G(^LAM(+LRCC,0)),U,2)_" "_$P(^(0),U),!
|
|
. G ERR:'$D(^LAM(LRCC,0)) S ^TMP("LR",$J,"CAPN",$P(^(0),U))=LRCC
|
|
S LRJ=0,LRJ=$O(^LAB(60,LRTS,9,LRJ)) I LRJ>0 D Q:$G(LREND)
|
|
.D NAME W ?15,"Verify",! D
|
|
..D:$D(^LAB(60,LRTS,9,LRJ,0))#2 PCC
|
|
..F LRK=0:0 S LRJ=$O(^LAB(60,LRTS,9,LRJ)) Q:(LRJ<1)!($G(LREND)) D:$D(^LAB(60,LRTS,9,LRJ,0))#2 PCC
|
|
Q:$G(LREND)
|
|
S LRJ=+$O(^LAB(60,LRTS,9.1,0))
|
|
Q:'LRJ
|
|
D NAME W ?15,"Accession",! D Q:$G(LREND)
|
|
.D:$D(^LAB(60,LRTS,9.1,LRJ,0))#2 PCC2
|
|
.F LRK=0:0 S LRJ=$O(^LAB(60,LRTS,9.1,LRJ)) Q:LRJ<1!($G(LREND)) D:$D(^LAB(60,LRTS,9.1,LRJ,0))#2 PCC2
|
|
Q:$G(LREND)
|
|
S LRJ=+$O(^LAB(60,LRTS,3,1,9,0))
|
|
Q:'LRJ
|
|
D NAME W ?15,"Sample",! D
|
|
.D:$D(^LAB(60,LRTS,3,1,9,LRJ,0))#2 PCC3
|
|
.F LRK=0:0 S LRJ=$O(^LAB(60,LRTS,3,1,9,LRJ)) Q:(LRJ<1)!($G(LREND)) D:$D(^LAB(60,LRTS,3,1,9,LRJ,0))#2 PCC3
|
|
Q
|
|
PCC ;
|
|
Q:$G(LREND)
|
|
S LRX=^LAB(60,LRTS,9,LRJ,0),LRCC=+LRX G ERR:'$D(^LAM(LRCC,0)) S ^TMP("LR",$J,"CAP",$P(^(0),U))=LRCC
|
|
I $Y>(IOSL-6) D
|
|
.D PAUSE Q:$G(LREND)
|
|
.S NAME1=0 W @IOF D HEAD,NAME W ?15,"Verify",!
|
|
Q:$G(LREND)
|
|
W ?10,$S($D(^LAM(LRCC,0))#2:$S($P(^(0),U,5):"+"_$P(^(0),U),1:$P(^(0),U)),1:""),?50,$P(LRX,U,2),?73,$S($P(LRX,U,3):$P(LRX,U,3),1:"1"),!
|
|
Q
|
|
PCC2 ;
|
|
Q:$G(LREND)
|
|
S LRX=^LAB(60,LRTS,9.1,LRJ,0),LRCC=+LRX G ERR:'$D(^LAM(LRCC,0)) S ^TMP("LR",$J,"CAP",$P(^(0),U))=LRCC
|
|
I $Y>(IOSL-6) D
|
|
.D PAUSE Q:$G(LREND)
|
|
.S NAME1=0 W @IOF D HEAD,NAME W ?15,"Accession",!
|
|
Q:$G(LREND)
|
|
W ?10,$S($D(^LAM(LRCC,0))#2:$S($P(^(0),U,5):"+"_$P(^(0),U),1:$P(^(0),U)),1:""),?50,$P(LRX,U,2),?73,$S($P(LRX,U,3):$P(LRX,U,3),1:"1"),!
|
|
Q
|
|
PCC3 ;
|
|
Q:$G(LREND)
|
|
S LRX=^LAB(60,LRTS,3,1,9,LRJ,0),LRCC=+LRX G ERR:'$D(^LAM(LRCC,0)) S ^TMP("LR",$J,"CAP",$P(^(0),U))=LRCC
|
|
I $Y>(IOSL-6) D
|
|
.D PAUSE Q:$G(LREND)
|
|
.S NAME1=0 W @IOF D HEAD,NAME W ?15,"Sample",!
|
|
Q:$G(LREND)
|
|
W ?10,$S($D(^LAM(LRCC,0))#2:$S($P(^(0),U,5):"+"_$P(^(0),U),1:$P(^(0),U)),1:""),?50,$P(LRX,U,2),?73,$S($P(LRX,U,3):$P(LRX,U,3),1:"1"),!
|
|
Q
|
|
HEAD ;
|
|
Q:$G(LREND)
|
|
S LRPAG=$G(LRPAG)+1
|
|
W !!?21,"LIST OF FILE 60 WKLD CODES",?70,"Page ",$J(LRPAG,3),!
|
|
W !,"IEN",?15,"WKLD Code [TYPE] ",?50,"WKLD Number",?73,"X",!,LRLINE,!
|
|
Q
|
|
HEAD2 ;
|
|
Q:$G(LREND)
|
|
S LRPAG=$G(LRPAG)+1
|
|
W !!?10,"Alphabetical Listing of WKLD Codes Defined"
|
|
W ?72,"Page ",$J(LRPAG,3),!
|
|
Q
|
|
HEAD3 ;
|
|
Q:$G(LREND)
|
|
S LRPAG=$G(LRPAG)+1
|
|
W !!?10,"Alphabetical Listing of NLT or Result NLT Codes Defined"
|
|
W ?72,"Page ",$J(LRPAG,3),!
|
|
Q
|
|
NAME ;
|
|
S LRTY=$P(^LAB(60,LRTS,0),U,3) W:'$G(NAME1) !,LRTS,?6,$P(^LAB(60,LRTS,0),U),"[ "_$S(LRTY="I":"INPUT",LRTY="O":"OUTPUT",LRTY="B":"BOTH",1:"NEITHER")_" ]",!
|
|
S NAME1=1
|
|
Q
|
|
ERR W !?10,$C(7)," Error in WKLD Code pointer (",$G(LRCC),") ***** ",!
|
|
Q
|
|
PAUSE ;
|
|
Q:$G(LREND)
|
|
Q:$E(IOST,1,2)'="C-"
|
|
K DIR,X,Y S DIR(0)="E" D ^DIR
|
|
S:($D(DTOUT))!($D(DUOUT)) LREND=1
|
|
Q
|
|
CLEAN I $D(ZTQUEUED) S ZTREQ="@"
|
|
W !! W:$E(IOST,1,2)="P-" @IOF
|
|
D ^%ZISC
|
|
K %ZIS,DA,DIC,DR,LRI,LRLINE,LRHED,LRI,LRJ,LRK,LRTS,LRTSN,LRX,NAME,NAME1
|
|
K %,LRCC,LREND,X,Y,ZTSK,DTOUT,DUOUT,DIRUT,LRPAG,DIR,DX,S
|
|
K ^TMP("LR",$J,"CAP"),^TMP("LR",$J,"CAPN")
|
|
Q
|