source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRAPQAT.m@ 1516

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1LRAPQAT ;AVAMC/REG/CYM - TC CODE SEARCH ;7/31/97 09:38
2 ;;5.2;LAB SERVICE;**72,85,173**;Sep 27, 1994
3 D END,A^LRAPD G:'$D(Y) END D W G:%'=1 END
4 W ! F B=1:1 D ASK Q:Z=""!(Z[U)
5 G:B<2 END W ! D B^LRU G:Y<0 END S LRA=LRSDT-.01,LRLDT=LRLDT+.99
6 W !!,"Also print cumulative path data summaries " S %=2 D YN^LRU G:%<1 END S:%=1 LRG=1
7 S ZTRTN="QUE^LRAPQAT" D BEG^LRUTL G:POP!($D(ZTSK)) END
8QUE U IO K ^TMP($J) S (LRZ,LRM("NONE"))=0,LRQ(9)=1,LRM("NONE",0)="" D L^LRU,S^LRU,XR^LRU,H S LR("F")=1
9 F LRX=0:0 S LRA=$O(^LR(LRXR,LRA)) Q:'LRA!(LRA>LRLDT) F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRA,LRDFN)) Q:'LRDFN F LRI=0:0 S LRI=$O(^LR(LRXR,LRA,LRDFN,LRI)) Q:'LRI I $P($P($G(^LR(LRDFN,LRSS,LRI,0)),U,6)," ")=LRABV S X=^(0),Y=$P(X,U,14) D X
10 S LRA=-1 F LRB=0:0 S LRA=$O(LRM(LRA)) Q:LRA=""!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") W !!,"TC Code: ",LRA," ",LRM(LRA,0) S LRP=0 D P
11 D H2 Q:LR("Q") W !,LR("%") I LRZ=0 W !!?15,"No Accesions in Time period" Q
12 W !!?10,"TC Code",?20,"Count",?30,"% of Accessions" S LRA=-1 F LRB=0:0 S LRA=$O(LRM(LRA)) Q:LRA=""!(LR("Q")) W !?12,LRA,?20,$J(LRM(LRA),5),?35,$J(LRM(LRA)*100/LRZ,5,2)
13 W !?20,"-----",!,"Total",?20,$J(LRZ,5),! S LRA=-1 F LRB=0:0 S LRA=$O(LRM(LRA)) Q:LRA="" W !,"TC Code: ",LRA,?12,LRM(LRA,0)
14 D:$D(LRG) ^LRAPQAT1 D END,END^LRUTL Q
15P F LRC=0:0 S LRP=$O(^TMP("LRAP",$J,LRP)) Q:LRP="" F LRDFN=0:0 S LRDFN=$O(^TMP("LRAP",$J,LRP,LRDFN)) Q:'LRDFN S LRX=^(LRDFN) D Y
16 Q
17Y Q:'$D(^TMP($J,LRA,LRDFN)) F LRD=0:0 S LRD=$O(^TMP($J,LRA,LRDFN,LRD)) Q:'LRD!(LR("Q")) D D
18 Q
19D S LRE=0 F LRF=0:0 S LRE=$O(^TMP($J,LRA,LRDFN,LRD,LRE)) Q:LRE=""!(LR("Q")) D:$Y>(IOSL-6) H1 Q:LR("Q") W !,LRP,?32,$P(LRX,"^"),?46,$J(LRE,5),?62 S Y=LRD D D^LRU W Y
20 Q
21X S LRZ=LRZ+1,A=$P(X,"^",6) S:A="" A="?" I Y="" S LRM("NONE")=LRM("NONE")+1,^TMP($J,"NONE",LRDFN,+X,A)="" D B Q
22 I $D(LRM(Y)) S ^TMP($J,Y,LRDFN,+X,A)="",LRM(Y)=LRM(Y)+1 D B
23 Q
24B S X=^LR(LRDFN,0),Y=$P(X,"^",3),(LRDPF,LR)=$P(X,"^",2),X=^DIC(LR,0,"GL"),X=@(X_Y_",0)"),SSN=$P(X,"^",9) D SSN^LRU S ^TMP("LRAP",$J,$P(X,"^"),LRDFN)=SSN_"^"_$S(LR=2:Y,1:"")_"^"_$P(X,"^",3)_"^"_$P(X,"^",2) Q
25 ;
26ASK W !,"Select a number from 0 to 9 (Choice# ",B,"): " R Z:DTIME Q:Z=""!(Z[U) I Z'?1N W $C(7),!!?18,"Only numbers 0,1,2,3,4,5,6,7,8 or 9 allowed.",!?18,"A repeat selection replaces the original one.",! G ASK
27A S L(1)="S",L=68,X=Z D ^LRUB
28C W !,"ENTER IDENTIFYING COMMENT: ",X,"// " R X(1):DTIME I '$T!(X(1)[U) W $C(7),!,"You must enter an identifying comment <SELECTION DELETED>",! K LRM(Z) S B=B-1 G ASK
29 S:X(1)="" X(1)=X I X(1)["?" S L(1)="S" D Q^LRUB G A
30 I X(1)["@" W $C(7),!,"Deletion not allowed" G A
31 I X(1)'?1ANP.ANP!($L(X(1))<1)!($L(X(1))>68)!(X(1)["?") W $C(7),!!,"Enter free text 2-68 characters." G A
32 S LRM(Z,0)=X(1),LRM(Z)=0 Q
33H2 I $D(LR("F")),$E(IOST,1,2)="C-" D M^LRU Q:LR("Q")
34 D F^LRU W !,LRO(68)," -TC Code Search from ",LRSTR," to ",LRLST Q
35H D H2 W !,"Patient",?35,"SSN",?45,"Acc#",?60,"Date obtained",!,LR("%") Q
36H1 D H W !!,"TC Code: ",LRA," ",LRM(LRA,0) Q
37 ;
38END K ^TMP("LRAP",$J) D V^LRU Q
39W W !!?10,LRO(68)," (",LRABV,") -TC CODE SEARCH",!!,"This report may take a while and should be queued to print at non-peak hours.",!?32,"OK to continue " S %=2 D YN^LRU Q
Note: See TracBrowser for help on using the repository browser.