- LRAPQOR2 ;AVAMC/REG/CYM - QA AUTOPSY DATA ;2/13/97 07:52
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPQOR2 1694 printed Mar 13, 2025@21:12:26 Page 2
- LRAPQOR2 ;AVAMC/REG/CYM - QA AUTOPSY DATA ;2/13/97 07:52
- +1 ;;5.2;LAB SERVICE;**155**;Sep 27, 1994
- +2 DO FIELD^DID(63,14.5,"","POINTER","LRS")
- SET LRS=LRS("POINTER")_"?:?;"
- DO H1
- +3 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
- +4 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
