source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPQOR.m@ 1766

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1LRAPQOR ;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
7QUE 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
10I F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN!(LR("Q")) D @($S("CYEMSP"[LRSS:"L",1:"A"))
11 Q
12L 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
14B 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
17W 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
18W1 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
19S 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
21A 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
25H 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
28H1 D H Q:LR("Q") W !,LRZ,?10,LRY,?20,LRC Q
29T 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 ;
32END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.