LRAUS.m

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