| 1 | LRAPQOR ;AVAMC/REG/CYM - QA CODE REPORT ;2/12/98 09:21
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994
|
|---|
| 3 | D ^LRAP G:'$D(Y) END D B^LRU G:Y<0 END
|
|---|
| 4 | S (LRSDT(1),LRSDT)=LRSDT-.01,LRLDT=LRLDT+.99 W !!,"Sort by QA CODE / PATHOLOGIST " S %=2 D YN^LRU G:%<1 END I %=1 G ^LRAPQOR1
|
|---|
| 5 | W !!,"Print all QA codes " S %=1 D YN^LRU G:%<1 END I %=2 D T G:'$D(LRB) END
|
|---|
| 6 | S ZTRTN="QUE^LRAPQOR" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|---|
| 7 | QUE U IO K ^TMP($J) D XR^LRU,L^LRU,S^LRU,H S LR("F")=1
|
|---|
| 8 | F X=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D I
|
|---|
| 9 | K ^TMP($J) W:IOST'?1"C".E @IOF D END^LRUTL,V^LRU Q
|
|---|
| 10 | I F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN!(LR("Q")) D @($S("CYEMSP"[LRSS:"L",1:"A"))
|
|---|
| 11 | Q
|
|---|
| 12 | L Q:'$D(^LR(LRDFN,0)) F LRI=0:0 S LRI=$O(^LR(LRXR,LRSDT,LRDFN,LRI)) Q:'LRI I $P($P($G(^LR(LRDFN,LRSS,LRI,0)),U,6)," ")=LRABV,$O(^LR(LRDFN,LRSS,LRI,9,0)) D B
|
|---|
| 13 | Q
|
|---|
| 14 | B I $D(LRB) K LRF F X=0:0 S X=$O(LRB(X)) Q:'X I $D(^LR(LRDFN,LRSS,LRI,9,X)) S LRF=1 Q
|
|---|
| 15 | I $D(LRB),'$D(LRF) Q
|
|---|
| 16 | S X=^LR(LRDFN,LRSS,LRI,0),Z=$P(X,"^",2),Y=$P($P(X,"^",10),"."),LRZ=$P(X,"^",6) D S Q
|
|---|
| 17 | W S LRY=$$FMTE^XLFDT(Y),LRC=$S('Z:"",'$D(^VA(200,Z,0)):"",1:$P(^(0),"^")) D:$Y>(IOSL-6) H Q:LR("Q") W !!,LRZ,?10,LRY,?24,LRC Q
|
|---|
| 18 | W1 D:$Y>(IOSL-6) H1 Q:LR("Q") S X=$S($D(^LAB(62.5,LRA,0)):^(0),1:"") W !,$P(X,"^"),?4,$P(X,"^",2) Q
|
|---|
| 19 | S D W Q:LR("Q") F LRA=0:0 S LRA=$O(^LR(LRDFN,LRSS,LRI,9,LRA)) Q:'LRA D W1 Q:LR("Q")
|
|---|
| 20 | Q
|
|---|
| 21 | A Q:$P($P($G(^LR(LRDFN,"AU")),U,6)," ")'=LRABV Q:'$O(^LR(LRDFN,99,0)) I $D(LRB) K LRF F X=0:0 S X=$O(LRB(X)) Q:'X I $D(^LR(LRDFN,99,X)) S LRF=1 Q
|
|---|
| 22 | I $D(LRB),'$D(LRF) Q
|
|---|
| 23 | Q:'$D(^LR(LRDFN,"AU")) S X=^("AU"),Y=$P($P(X,"^"),"."),LRZ=$P(X,"^",6),Z=$P(X,"^",10) D W Q:LR("Q") F LRA=0:0 S LRA=$O(^LR(LRDFN,99,LRA)) Q:'LRA D W1 Q:LR("Q")
|
|---|
| 24 | Q
|
|---|
| 25 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 26 | D F^LRU W !,"QA CODES for ",LRO(68)," From: ",LRSTR," To: ",LRLST
|
|---|
| 27 | W !,"Acc #",?10,$S(LRSS'="AU":"Rec'd",1:"Date"),?24,"Pathologist",!,LR("%") Q
|
|---|
| 28 | H1 D H Q:LR("Q") W !,LRZ,?10,LRY,?20,LRC Q
|
|---|
| 29 | T S DIC="^LAB(62.5,",DIC(0)="AEQ",D="AI",DIC("A")="Select QA CODE: ",DIC("S")="I $L($P(^(0),U))<3" D IX^DIC K DIC I Y>0 S LRB(+Y)="" G T
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | END D V^LRU Q
|
|---|
