| 1 | LRAPQOR2 ;AVAMC/REG/CYM - QA AUTOPSY DATA ;2/13/97  07:52 | 
|---|
| 2 | ;;5.2;LAB SERVICE;**155**;Sep 27, 1994 | 
|---|
| 3 | D FIELD^DID(63,14.5,"","POINTER","LRS") S LRS=LRS("POINTER")_"?:?;" D H1 | 
|---|
| 4 | F LRA=0:0 S LRA=$O(^TMP($J,LRA)) Q:'LRA!(LR("Q"))  S LRM=0,LRB=$S($D(^LAB(62.5,LRA,0)):^(0),1:"??") D:$Y>(IOSL-6) H1 Q:LR("Q")  W !!,$P(LRB,U),?5,$P(LRB,U,2) D S | 
|---|
| 5 | Q:LR("Q")  D ^LRAPQOR3 Q | 
|---|
| 6 | S S LRI="" F  S LRI=$O(^TMP($J,"S",LRA,LRI)) Q:LRI=""!(LR("Q"))  D:$Y>(IOSL-6) H2 Q:LR("Q")  S LRK=LRI_":",LRK=$P($P(LRS,LRK,2),";") W !!?5,"SERVICE: ",LRK D T | 
|---|
| 7 | Q:LR("Q")  W !,"Total QA Codes for ",$P(LRB,U),": ",LRM Q | 
|---|
| 8 | T S LRL="" F  S LRL=$O(^TMP($J,"S",LRA,LRI,LRL)) Q:LRL=""!(LR("Q"))  D:$Y>(IOSL-6) H3 Q:LR("Q")  S LRL(1)=$S(LRL="?":"?",1:$P($G(^DIC(45.7,LRL,0)),U)) W !?7,"TREATING SPECIALTY: ",LRL(1) D M | 
|---|
| 9 | Q | 
|---|
| 10 | M S LRP="" F  S LRP=$O(^TMP($J,"S",LRA,LRI,LRL,LRP)) Q:LRP=""!(LR("Q"))  D:$Y>(IOSL-6) H4 Q:LR("Q")  S LRP(1)=$S(LRP="?":"?",1:$P($G(^VA(200,LRP,0)),U)) W !?10,"CLINICIAN: ",LRP(1) D A | 
|---|
| 11 | Q | 
|---|
| 12 | A S LRC=0 F  S LRC=$O(^TMP($J,"S",LRA,LRI,LRL,LRP,LRC)) Q:'LRC  D | 
|---|
| 13 | . Q:(LR("Q"))>0 | 
|---|
| 14 | . S LRY=$$FMTE^XLFDT(LRC,"D"),LRD="" | 
|---|
| 15 | . S LRF=0 F  S LRF=$O(^TMP($J,"S",LRA,LRI,LRL,LRP,LRC,LRF)) Q:LRF']""  D | 
|---|
| 16 | .. Q:(LR("Q"))>0  D W Q | 
|---|
| 17 | Q | 
|---|
| 18 | W D:$Y>(IOSL-6) H5 Q:LR("Q")  W !?13,"Autopsy: ",$J(LRF,4),?35,"Date: ",LRY S LRM=LRM+1 Q | 
|---|
| 19 | D ^LRAPQOR3 Q | 
|---|
| 20 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q") | 
|---|
| 21 | D F^LRU W !,"QA CODES by SERVICE, TREATING SPECIALTY and CLINICIAN",!,"From ",LRSTR," To ",LRLST Q | 
|---|
| 22 | H1 D H Q:LR("Q")  W !,LR("%") Q | 
|---|
| 23 | H2 D H1 Q:LR("Q")  W !,$P(LRB,U),?5,$P(LRB,U,2) Q | 
|---|
| 24 | H3 D H2 Q:LR("Q")  W !!?5,"SERVICE: ",LRK Q | 
|---|
| 25 | H4 D H3 Q:LR("Q")  W !?7,"TREATING SPECIALTY: ",LRL(1) Q | 
|---|
| 26 | H5 D H4 Q:LR("Q")  W !?10,"CLINICIAN: ",LRP(1) Q | 
|---|