[613] | 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
|
---|