LRAUS ;AVAMC/REG - PRINT ICD SEARCH ;9/13/89 18:55 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
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
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)
W !,"ACC NUM",?9,"NAME",?28,"ID",?33,"SEX",?37,"AGE",?41,"MO/DA",!,LR("%") Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAUS 946 printed Nov 22, 2024@17:19:51 Page 2
LRAUS ;AVAMC/REG - PRINT ICD SEARCH ;9/13/89 18:55 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 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
+3 FOR Y=0:0
SET Y=$ORDER(^TMP($JOB,Y))
if 'Y!(LR("Q"))
QUIT
DO N
+4 IF $DATA(LRSS)
IF LRSS="AU"
WRITE !!,"NUMBER OF AUTOPSIES SEARCHED WITH ",$PIECE(^TMP($JOB,0,1)," ",1)," CODING: ",LRPAT1
+5 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 DO F^LRU
WRITE !,T(0)," SEARCH (",LRSTR,"=>",LRLST,")",!,^TMP($JOB,0,1)
+2 WRITE !,"ACC NUM",?9,"NAME",?28,"ID",?33,"SEX",?37,"AGE",?41,"MO/DA",!,LR("%")
QUIT
