- LRAUS ; IHS/DIR/FJE - PRINT ICD SEARCH ; 17-Oct-2014 09:22 ; MKK
- ;;5.2;LR;**1001,1034**;NOV 01, 1997;Build 88
- ;
- S LRND=^TMP($J,0),T(0)=$P(LRND,"^",3),LRFLD=$P(LRND,"^",4) D L^LRU,H S LR("F")=1
- F Y=0:0 S Y=$O(^TMP($J,Y)) Q:'Y!(LR("Q")) D N
- ; I $D(LRSS),LRSS="AU" W !!,"NUMBER OF AUTOPSIES SEARCHED WITH ",$P(^TMP($J,0,1)," ",1)," CODING: ",LRPAT1
- ;
- ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
- I $D(LRSS),LRSS="AU" D
- . NEW SRCHWITH
- . S SRCHWITH=$P(^TMP($J,0,1)," ",1)
- . S:SRCHWITH["ICD9" SRCHWITH=$TR(SRCHWITH,"9")
- . W !!,"NUMBER OF AUTOPSIES SEARCHED WITH ",SRCHWITH," CODING: ",LRPAT1
- ; ----- END IHS/MSC/MKK - LR*5.2*1034
- ;
- K T(0),LRFLD,LRND Q
- N F N=0:0 S N=$O(^TMP($J,Y,N)) Q:'N!(LR("Q")) S LRND=^(N) D:$Y>(IOSL-6) H Q:LR("Q") W !,$P(LRND,"^"),?9,$E($P(LRND,"^",4),1,18),?28,$P(LRND,"^",5),?34,$P(LRND,"^",3),?38,$P(LRND,"^",2),?41,$J($P(LRND,"^",6),5) D T
- Q
- T S T=0 F A=0:1 S T=$O(^TMP($J,Y,N,T)) Q:'T!(LR("Q")) W:A>0 ! W ?47,$E(^(T),1,16) D D
- Q
- D S M=0 F B=0:1 S M=$O(^TMP($J,Y,N,T,M)) Q:'M!(LR("Q")) W:B>0 ! W ?65,$E(^(M),1,15)
- Q
- H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
- ; D F^LRU W !,T(0)," SEARCH (",LRSTR,"=>",LRLST,")",!,^TMP($J,0,1)
- ;
- ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
- NEW SRCHWITH
- S SRCHWITH=$P(^TMP($J,0,1)," ",1)
- S:SRCHWITH["ICD9" SRCHWITH=$TR(SRCHWITH,"9")
- D F^LRU W !,T(0)," SEARCH (",LRSTR,"=>",LRLST,")",!,SRCHWITH
- ; ----- END IHS/MSC/MKK - LR*5.2*1034
- ;
- W !,"ACC NUM",?9,"NAME",?28,"ID",?33,"SEX",?37,"AGE",?41,"MO/DA",!,LR("%") Q
- LRAUS ; IHS/DIR/FJE - PRINT ICD SEARCH ; 17-Oct-2014 09:22 ; MKK
- +1 ;;5.2;LR;**1001,1034**;NOV 01, 1997;Build 88
- +2 ;
- +3 SET LRND=^TMP($JOB,0)
- SET T(0)=$PIECE(LRND,"^",3)
- SET LRFLD=$PIECE(LRND,"^",4)
- DO L^LRU
- DO H
- SET LR("F")=1
- +4 FOR Y=0:0
- SET Y=$ORDER(^TMP($JOB,Y))
- IF 'Y!(LR("Q"))
- QUIT
- DO N
- +5 ; I $D(LRSS),LRSS="AU" W !!,"NUMBER OF AUTOPSIES SEARCHED WITH ",$P(^TMP($J,0,1)," ",1)," CODING: ",LRPAT1
- +6 ;
- +7 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
- +8 IF $DATA(LRSS)
- IF LRSS="AU"
- Begin DoDot:1
- +9 NEW SRCHWITH
- +10 SET SRCHWITH=$PIECE(^TMP($JOB,0,1)," ",1)
- +11 IF SRCHWITH["ICD9"
- SET SRCHWITH=$TRANSLATE(SRCHWITH,"9")
- +12 WRITE !!,"NUMBER OF AUTOPSIES SEARCHED WITH ",SRCHWITH," CODING: ",LRPAT1
- End DoDot:1
- +13 ; ----- END IHS/MSC/MKK - LR*5.2*1034
- +14 ;
- +15 KILL T(0),LRFLD,LRND
- QUIT
- N FOR N=0:0
- SET N=$ORDER(^TMP($JOB,Y,N))
- IF 'N!(LR("Q"))
- QUIT
- SET LRND=^(N)
- IF $Y>(IOSL-6)
- DO H
- IF LR("Q")
- QUIT
- WRITE !,$PIECE(LRND,"^"),?9,$EXTRACT($PIECE(LRND,"^",4),1,18),?28,$PIECE(LRND,"^",5),?34,$PIECE(LRND,"^",3),?38,$PIECE(LRND,"^",2),?41,$JUSTIFY($PIECE(LRND,"^",6),5)
- DO T
- +1 QUIT
- T SET T=0
- FOR A=0:1
- SET T=$ORDER(^TMP($JOB,Y,N,T))
- IF 'T!(LR("Q"))
- QUIT
- IF A>0
- WRITE !
- WRITE ?47,$EXTRACT(^(T),1,16)
- DO D
- +1 QUIT
- D SET M=0
- FOR B=0:1
- SET M=$ORDER(^TMP($JOB,Y,N,T,M))
- IF 'M!(LR("Q"))
- QUIT
- IF B>0
- WRITE !
- WRITE ?65,$EXTRACT(^(M),1,15)
- +1 QUIT
- H IF $DATA(LR("F"))
- IF IOST?1"C".E
- DO M^LRU
- IF LR("Q")
- QUIT
- +1 ; D F^LRU W !,T(0)," SEARCH (",LRSTR,"=>",LRLST,")",!,^TMP($J,0,1)
- +2 ;
- +3 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
- +4 NEW SRCHWITH
- +5 SET SRCHWITH=$PIECE(^TMP($JOB,0,1)," ",1)
- +6 IF SRCHWITH["ICD9"
- SET SRCHWITH=$TRANSLATE(SRCHWITH,"9")
- +7 DO F^LRU
- WRITE !,T(0)," SEARCH (",LRSTR,"=>",LRLST,")",!,SRCHWITH
- +8 ; ----- END IHS/MSC/MKK - LR*5.2*1034
- +9 ;
- +10 WRITE !,"ACC NUM",?9,"NAME",?28,"ID",?33,"SEX",?37,"AGE",?41,"MO/DA",!,LR("%")
- QUIT
