- LRAPQOR2 ; IHS/DIR/AAB - QA AUTOPSY DATA 07:52 ; [ 2/13/97 ]
- ;;5.2;LR;**1006**;SEP 01, 1998
- ;
- ;;5.2;LAB SERVICE;**155**;Sep 27, 1994
- D FIELD^DID(63,14.5,"","POINTER","LRS") S LRS=LRS("POINTER")_"?:?;" D H1
- 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
- Q:LR("Q") D ^LRAPQOR3 Q
- 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
- Q:LR("Q") W !,"Total QA Codes for ",$P(LRB,U),": ",LRM Q
- 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
- Q
- 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
- Q
- A S LRC=0 F S LRC=$O(^TMP($J,"S",LRA,LRI,LRL,LRP,LRC)) Q:'LRC D
- . Q:(LR("Q"))>0
- . S LRY=$$FMTE^XLFDT(LRC,"D"),LRD=""
- . S LRF=0 F S LRF=$O(^TMP($J,"S",LRA,LRI,LRL,LRP,LRC,LRF)) Q:LRF']"" D
- .. Q:(LR("Q"))>0 D W Q
- Q
- W D:$Y>(IOSL-6) H5 Q:LR("Q") W !?13,"Autopsy: ",$J(LRF,4),?35,"Date: ",LRY S LRM=LRM+1 Q
- D ^LRAPQOR3 Q
- H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
- D F^LRU W !,"QA CODES by SERVICE, TREATING SPECIALTY and CLINICIAN",!,"From ",LRSTR," To ",LRLST Q
- H1 D H Q:LR("Q") W !,LR("%") Q
- H2 D H1 Q:LR("Q") W !,$P(LRB,U),?5,$P(LRB,U,2) Q
- H3 D H2 Q:LR("Q") W !!?5,"SERVICE: ",LRK Q
- H4 D H3 Q:LR("Q") W !?7,"TREATING SPECIALTY: ",LRL(1) Q
- H5 D H4 Q:LR("Q") W !?10,"CLINICIAN: ",LRP(1) Q
- LRAPQOR2 ; IHS/DIR/AAB - QA AUTOPSY DATA 07:52 ; [ 2/13/97 ]
- +1 ;;5.2;LR;**1006**;SEP 01, 1998
- +2 ;
- +3 ;;5.2;LAB SERVICE;**155**;Sep 27, 1994
- +4 DO FIELD^DID(63,14.5,"","POINTER","LRS")
- SET LRS=LRS("POINTER")_"?:?;"
- DO H1
- +5 FOR LRA=0:0
- SET LRA=$ORDER(^TMP($JOB,LRA))
- IF 'LRA!(LR("Q"))
- QUIT
- SET LRM=0
- SET LRB=$SELECT($DATA(^LAB(62.5,LRA,0)):^(0),1:"??")
- IF $Y>(IOSL-6)
- DO H1
- IF LR("Q")
- QUIT
- WRITE !!,$PIECE(LRB,U),?5,$PIECE(LRB,U,2)
- DO S
- +6 IF LR("Q")
- QUIT
- DO ^LRAPQOR3
- QUIT
- S SET LRI=""
- FOR
- SET LRI=$ORDER(^TMP($JOB,"S",LRA,LRI))
- IF LRI=""!(LR("Q"))
- QUIT
- IF $Y>(IOSL-6)
- DO H2
- IF LR("Q")
- QUIT
- SET LRK=LRI_":"
- SET LRK=$PIECE($PIECE(LRS,LRK,2),";")
- WRITE !!?5,"SERVICE: ",LRK
- DO T
- +1 IF LR("Q")
- QUIT
- WRITE !,"Total QA Codes for ",$PIECE(LRB,U),": ",LRM
- QUIT
- T SET LRL=""
- FOR
- SET LRL=$ORDER(^TMP($JOB,"S",LRA,LRI,LRL))
- IF LRL=""!(LR("Q"))
- QUIT
- IF $Y>(IOSL-6)
- DO H3
- IF LR("Q")
- QUIT
- SET LRL(1)=$SELECT(LRL="?":"?",1:$PIECE($GET(^DIC(45.7,LRL,0)),U))
- WRITE !?7,"TREATING SPECIALTY: ",LRL(1)
- DO M
- +1 QUIT
- M SET LRP=""
- FOR
- SET LRP=$ORDER(^TMP($JOB,"S",LRA,LRI,LRL,LRP))
- IF LRP=""!(LR("Q"))
- QUIT
- IF $Y>(IOSL-6)
- DO H4
- IF LR("Q")
- QUIT
- SET LRP(1)=$SELECT(LRP="?":"?",1:$PIECE($GET(^VA(200,LRP,0)),U))
- WRITE !?10,"CLINICIAN: ",LRP(1)
- DO A
- +1 QUIT
- A SET LRC=0
- FOR
- SET LRC=$ORDER(^TMP($JOB,"S",LRA,LRI,LRL,LRP,LRC))
- IF 'LRC
- QUIT
- Begin DoDot:1
- +1 IF (LR("Q"))>0
- QUIT
- +2 SET LRY=$$FMTE^XLFDT(LRC,"D")
- SET LRD=""
- +3 SET LRF=0
- FOR
- SET LRF=$ORDER(^TMP($JOB,"S",LRA,LRI,LRL,LRP,LRC,LRF))
- IF LRF']""
- QUIT
- Begin DoDot:2
- +4 IF (LR("Q"))>0
- QUIT
- DO W
- QUIT
- End DoDot:2
- End DoDot:1
- +5 QUIT
- W IF $Y>(IOSL-6)
- DO H5
- IF LR("Q")
- QUIT
- WRITE !?13,"Autopsy: ",$JUSTIFY(LRF,4),?35,"Date: ",LRY
- SET LRM=LRM+1
- QUIT
- +1 DO ^LRAPQOR3
- QUIT
- H IF $DATA(LR("F"))
- IF IOST?1"C".E
- DO M^LRU
- IF LR("Q")
- QUIT
- +1 DO F^LRU
- WRITE !,"QA CODES by SERVICE, TREATING SPECIALTY and CLINICIAN",!,"From ",LRSTR," To ",LRLST
- QUIT
- H1 DO H
- IF LR("Q")
- QUIT
- WRITE !,LR("%")
- QUIT
- H2 DO H1
- IF LR("Q")
- QUIT
- WRITE !,$PIECE(LRB,U),?5,$PIECE(LRB,U,2)
- QUIT
- H3 DO H2
- IF LR("Q")
- QUIT
- WRITE !!?5,"SERVICE: ",LRK
- QUIT
- H4 DO H3
- IF LR("Q")
- QUIT
- WRITE !?7,"TREATING SPECIALTY: ",LRL(1)
- QUIT
- H5 DO H4
- IF LR("Q")
- QUIT
- WRITE !?10,"CLINICIAN: ",LRP(1)
- QUIT
