source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRSPSICP.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1LRSPSICP ;AVAMC/REG - SEARCH BY ICD CODE PRINT ;8/15/95 08:50 ;
2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
3 S N=0 D H,H1 S LR("F")=1
4 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
5 S H(2)=1 D H,H2 Q:LR("Q") D L
6 Q
7A 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
8 Q
9ABC S LRAN=0 F C=0:1 S LRAN=$O(^TMP($J,"B",N,H(2),LRAN)) Q:'LRAN!(LR("Q")) D PRT
10 Q
11PRT 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)
12 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)
13 Q
14L F B=0:1 S H(2)=$O(^TMP($J,H(2))) Q:'H(2)!(LR("Q")) D LRAN
15 Q
16LRAN S LRAN=0 F C=0:1 S LRAN=$O(^TMP($J,H(2),LRAN)) Q:'LRAN!(LR("Q")) D PT
17 Q
18PT D:$Y>(IOSL-6) H,H2 Q:LR("Q")
19 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
20 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)
21 Q
22H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
23 D F^LRU W !,LRO(68)," SEARCH (",LRSTR,"=>",LRLST,")"
24 W !!,"ICD CODE: ",I(1),?30,I
25 W !,LR("%") Q
26H1 Q:LR("Q") W !!,?8,"NAME",?19,"ID",?23,"SEX",?27,"AGE",?32,"ACC #",!! Q
27H2 Q:LR("Q") W !!,"ACC #",?9,"NAME",?28,"ID",?33,"SEX",?37,"AGE",?41,"MO/DA" Q
28H3 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
29H4 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
Note: See TracBrowser for help on using the repository browser.