- LRSPSICP ; IHS/DIR/AAB - SEARCH BY ICD CODE PRINT ; 17-Oct-2014 09:22 ; MKK
- ;;5.2;LR;**1002,72,1034**;NOV 1, 1997;Build 88
- ;
- S N=0 D H,H1 S LR("F")=1
- F A=0:1 S N=$O(^TMP($J,"B",N)) Q:N=""!(LR("Q")) S V(2)=$O(^(N,0)),V(3)=$O(^(V(2),0)),V=^TMP($J,V(2),V(3)) D:$Y>(IOSL-6) H,H1 Q:LR("Q") W !,$E(N,1,18),?19,$P(V,"^",5),?25,$P(V,"^",3) D A
- S H(2)=1 D H,H2 Q:LR("Q") D L
- Q
- A S H(2)=0 F B=0:1 S H(2)=$O(^TMP($J,"B",N,H(2))) Q:'H(2)!(LR("Q")) D ABC
- Q
- ABC S LRAN=0 F C=0:1 S LRAN=$O(^TMP($J,"B",N,H(2),LRAN)) Q:'LRAN!(LR("Q")) D PRT
- Q
- PRT S V=^TMP($J,H(2),LRAN) W:C>0 ! W ?27,$P(V,"^",2) W ?31,$J($P(V,"^"),7),?39,$E($P(V,"^",8),1,18)
- S O=0 F Z=1:1 S O=$O(^TMP($J,H(2),LRAN,O)) Q:'O!(LR("Q")) D:$Y>(IOSL-6) H3 Q:LR("Q") W:Z>1 ! W ?58,$E(^(O),1,21)
- Q
- L F B=0:1 S H(2)=$O(^TMP($J,H(2))) Q:'H(2)!(LR("Q")) D LRAN
- Q
- LRAN S LRAN=0 F C=0:1 S LRAN=$O(^TMP($J,H(2),LRAN)) Q:'LRAN!(LR("Q")) D PT
- Q
- PT D:$Y>(IOSL-6) H,H2 Q:LR("Q")
- S V=^TMP($J,H(2),LRAN) W !,$J($P(V,"^"),7),?9,$E($P(V,"^",4),1,18),?28,$P(V,"^",5),?34,$P(V,"^",3),?37,$J($P(V,"^",2),3),?41
- W $J($P(V,"^",6),5),?47,$E($P(V,"^",8),1,15) S O=-1 F Z=1:1 S O=$O(^TMP($J,H(2),LRAN,O)) Q:'O!(LR("Q")) D:$Y>(IOSL-6) H4 Q:LR("Q") W:Z>1 ! W ?65,$E(^(O),1,14)
- Q
- H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
- D F^LRU W !,LRO(68)," SEARCH (",LRSTR,"=>",LRLST,")"
- W !!,"ICD CODE: ",I(1),?30,I
- W !,LR("%") Q
- H1 Q:LR("Q") W !!,?8,"NAME",?19,"ID",?23,"SEX",?27,"AGE",?32,"ACC #",!! Q
- H2 Q:LR("Q") W !!,"ACC #",?9,"NAME",?28,"ID",?33,"SEX",?37,"AGE",?41,"MO/DA" Q
- H3 D H,H1 Q:LR("Q") W !,$E(N,1,18),?19,$P(V,"^",5),?25,$P(V,"^",3),?27,$P(V,"^",2),?31,$J($P(V,"^"),7) Q
- H4 D H,H2 Q:LR("Q") W !,$J($P(V,"^"),7),?9,$E($P(V,"^",4),1,18),?28,$P(V,"^",5),?34,$P(V,"^",3),?37,$J($P(V,"^",2),3),?41,$J($P(V,"^",6),5) Q
- LRSPSICP ; IHS/DIR/AAB - SEARCH BY ICD CODE PRINT ; 17-Oct-2014 09:22 ; MKK
- +1 ;;5.2;LR;**1002,72,1034**;NOV 1, 1997;Build 88
- +2 ;
- +3 SET N=0
- DO H
- DO H1
- SET LR("F")=1
- +4 FOR A=0:1
- SET N=$ORDER(^TMP($JOB,"B",N))
- IF N=""!(LR("Q"))
- QUIT
- SET V(2)=$ORDER(^(N,0))
- SET V(3)=$ORDER(^(V(2),0))
- SET V=^TMP($JOB,V(2),V(3))
- IF $Y>(IOSL-6)
- DO H
- DO H1
- IF LR("Q")
- QUIT
- WRITE !,$EXTRACT(N,1,18),?19,$PIECE(V,"^",5),?25,$PIECE(V,"^",3)
- DO A
- +5 SET H(2)=1
- DO H
- DO H2
- IF LR("Q")
- QUIT
- DO L
- +6 QUIT
- A SET H(2)=0
- FOR B=0:1
- SET H(2)=$ORDER(^TMP($JOB,"B",N,H(2)))
- IF 'H(2)!(LR("Q"))
- QUIT
- DO ABC
- +1 QUIT
- ABC SET LRAN=0
- FOR C=0:1
- SET LRAN=$ORDER(^TMP($JOB,"B",N,H(2),LRAN))
- IF 'LRAN!(LR("Q"))
- QUIT
- DO PRT
- +1 QUIT
- PRT SET V=^TMP($JOB,H(2),LRAN)
- IF C>0
- WRITE !
- WRITE ?27,$PIECE(V,"^",2)
- WRITE ?31,$JUSTIFY($PIECE(V,"^"),7),?39,$EXTRACT($PIECE(V,"^",8),1,18)
- +1 SET O=0
- FOR Z=1:1
- SET O=$ORDER(^TMP($JOB,H(2),LRAN,O))
- IF 'O!(LR("Q"))
- QUIT
- IF $Y>(IOSL-6)
- DO H3
- IF LR("Q")
- QUIT
- IF Z>1
- WRITE !
- WRITE ?58,$EXTRACT(^(O),1,21)
- +2 QUIT
- L FOR B=0:1
- SET H(2)=$ORDER(^TMP($JOB,H(2)))
- IF 'H(2)!(LR("Q"))
- QUIT
- DO LRAN
- +1 QUIT
- LRAN SET LRAN=0
- FOR C=0:1
- SET LRAN=$ORDER(^TMP($JOB,H(2),LRAN))
- IF 'LRAN!(LR("Q"))
- QUIT
- DO PT
- +1 QUIT
- PT IF $Y>(IOSL-6)
- DO H
- DO H2
- IF LR("Q")
- QUIT
- +1 SET V=^TMP($JOB,H(2),LRAN)
- WRITE !,$JUSTIFY($PIECE(V,"^"),7),?9,$EXTRACT($PIECE(V,"^",4),1,18),?28,$PIECE(V,"^",5),?34,$PIECE(V,"^",3),?37,$JUSTIFY($PIECE(V,"^",2),3),?41
- +2 WRITE $JUSTIFY($PIECE(V,"^",6),5),?47,$EXTRACT($PIECE(V,"^",8),1,15)
- SET O=-1
- FOR Z=1:1
- SET O=$ORDER(^TMP($JOB,H(2),LRAN,O))
- IF 'O!(LR("Q"))
- QUIT
- IF $Y>(IOSL-6)
- DO H4
- IF LR("Q")
- QUIT
- IF Z>1
- WRITE !
- WRITE ?65,$EXTRACT(^(O),1,14)
- +3 QUIT
- H IF $DATA(LR("F"))
- IF IOST?1"C".E
- DO M^LRU
- IF LR("Q")
- QUIT
- +1 DO F^LRU
- WRITE !,LRO(68)," SEARCH (",LRSTR,"=>",LRLST,")"
- +2 WRITE !!,"ICD CODE: ",I(1),?30,I
- +3 WRITE !,LR("%")
- QUIT
- H1 IF LR("Q")
- QUIT
- WRITE !!,?8,"NAME",?19,"ID",?23,"SEX",?27,"AGE",?32,"ACC #",!!
- QUIT
- H2 IF LR("Q")
- QUIT
- WRITE !!,"ACC #",?9,"NAME",?28,"ID",?33,"SEX",?37,"AGE",?41,"MO/DA"
- QUIT
- H3 DO H
- DO H1
- IF LR("Q")
- QUIT
- WRITE !,$EXTRACT(N,1,18),?19,$PIECE(V,"^",5),?25,$PIECE(V,"^",3),?27,$PIECE(V,"^",2),?31,$JUSTIFY($PIECE(V,"^"),7)
- QUIT
- H4 DO H
- DO H2
- IF LR("Q")
- QUIT
- WRITE !,$JUSTIFY($PIECE(V,"^"),7),?9,$EXTRACT($PIECE(V,"^",4),1,18),?28,$PIECE(V,"^",5),?34,$PIECE(V,"^",3),?37,$JUSTIFY($PIECE(V,"^",2),3),?41,$JUSTIFY($PIECE(V,"^",6),5)
- QUIT
