source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRGEN2.m@ 724

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1LRGEN2 ;SLC/RWF-CUMULATIVE REPORT FOR SELECTED TESTS ;8/25/87 08:35
2 ;;5.2;LAB SERVICE;**121,153,221**;Sep 27, 1994
3TESTS ;from LRGEN
4 N LRCUTE
5 S LRTSTS=0,DIC="^LAB(60,",DIC(0)="AEMOQ",DIC("S")="I ""BO""[$P(^(0),U,3)!$D(^XUSEC(""LRLAB"",DUZ))" D ^DIC Q:Y<1 S LRONETST=+Y
6 I $L($P(^LAB(60,+Y,.1),U,5)) S LRCUTE=$P(^(.1),U,4,5) K DIC("S") D Q
7 . I $G(LRDONT) D LRTP S (LRIX,LRTSTS,LRPRETTY)=1,LRTEST(+LRONETST)=LRCUTE Q
8 . D @LRCUTE S LRTSTS=0 Q ;pretty print routine
9 D LRTP F I=0:0 D ^DIC Q:Y<0 S LRONETST="" D LRTP
10 D:'LRONETST SPEC Q:LREND I LRONETST S Y=+$O(LRTEST(0)) D LRTP D:'LRTP TYPE Q:LREND
11 S LRXPD="S LRSUB=$P(^TMP(""LR"",$J,""T"",X),U,5) S:$L(LRSUB) ^TMP(""LR"",$J,""TMP"",LRSUB)=^LAB(60,+$O(^LAB(60,""C"",LRSUB,0)),.1),^TMP(""LR"",$J,""TMP"",LRSUB,1)=$S($D(^LAB(60,+$O(^LAB(60,""C"",LRSUB,0)),1,LRTP,0)):^(0),1:"""")"
12 S LRTEST=0 F I=0:0 S LRTEST=+$O(LRTEST(LRTEST)) Q:LRTEST<1 S LREXPD=LRXPD D ^LREXPD
13COAG K LRXPD Q:LRTSTS>18 S LRSSP=0,LRIX=1,(LRPS,LRHDR,LRUT,LRNG)="",LRORD=+$O(LRORD(0)) I LRORD<1 W !!,$C(7),"TEST NOT IMPLEMENTED" Q
14 S LRTN=LRORD(LRORD),LRTN=$P(^TMP("LR",$J,"T",LRTN),U,5),LRPS=$P(LRTN,";"),LRIX(1)=0,LRSUB(1)=LRPS ;used by coag
15 I LRTN<0 W !!,$C(7),"TEST NOT IMPLEMENTED" Q
16 S:'$L($G(SEX)) SEX="M" S:'$L($G(AGE)) AGE=99
17 F I=0:0 D MUSH S LRORD=+$O(LRORD(LRORD)) Q:LRORD'>0 S LRTN=$P(^TMP("LR",$J,"T",LRORD(LRORD)),U,5) Q:LRTN<0
18 S:$L(LRHDR) LRHDR(LRIX)=$E(LRHDR,4,255),LRHDR(LRIX,1)=$E(LRUT,4,255),LRHDR(LRIX,2)=$E(LRNG,1,255) S LRSUB(LRIX+1)=LRSUB,LRIX(LRIX+1)=LRSSP S:'$L(LRHDR) LRIX=LRIX-1
19 K ^TMP("LR",$J,"TMP"),DIC,LRUT S LRHDR=""
20 Q
21MUSH I '$D(^XUSEC("LRLAB",DUZ)),"BO"'[$P(^LAB(60,LRORD(LRORD),0),U,3) Q
22 S X=^TMP("LR",$J,"TMP",LRTN),LRSUB=$P(LRTN,";",1)
23 I LRPS'=LRSUB D:LRIX(LRIX)'=LRSSP PUSH S LRSUB(LRIX)=LRSUB,LRPS=LRSUB
24 S LRSSP=LRSSP+1,LRND(LRSSP)=$P(LRTN,";",2),LRPP(LRSSP)=$P(LRTN,";",3) S:$L($P(X,U,3)) LRPR(LRSSP)=$P(X,U,3)
25 S LRHDR=LRHDR_$$RJ^XLFSTR($P(X,U),LRCW) S:LRTP LRUT=LRUT_$$RJ^XLFSTR($E($P(^TMP("LR",$J,"TMP",LRTN,1),U,7),1,7),LRCW)
26 I LRTP S X=$S($L($P(^TMP("LR",$J,"TMP",LRTN,1),U,11,12))>1:$P(^(1),U,11,12),$L($P(^(1),U,2,3))>1:$P(^(1)_"^",U,2,3)_"^1",1:"^^1"),LRHI=$P(X,U,2),LRLO=$P(X,U) S:'$P(X,U,3) LRTHER=1
27 I LRTP S @("LRHI="_$S($L(LRHI):LRHI,1:"""""")),@("LRLO="_$S($L(LRLO):LRLO,1:"""""")),LRNG=LRNG_$S($L(LRHI_LRLO):$$RJ^XLFSTR(LRLO_"-"_LRHI,LRCW),1:" ")
28 I LRSSP-LRIX(LRIX)#6=0 D PUSH S LRSUB(LRIX)=LRSUB,LRPS=LRSUB
29 Q
30PUSH S LRIX=LRIX+1,LRHDR(LRIX-1)=$E(LRHDR,4,255),LRHDR="",LRHDR(LRIX-1,1)=$E(LRUT,4,255),LRUT="",LRHDR(LRIX-1,2)=$E(LRNG,1,255),LRNG="",LRIX(LRIX)=LRSSP
31 Q
32LRTP S LRTP=""
33 I $P(^LAB(60,+Y,0),U,8) S LRTP=$S($D(^LAB(60,+Y,3,1,0)):+^(0),1:0),LRTP=$S($D(^LAB(62,LRTP,0)):$P(^(0),U,2),1:0) S:LRTP LRTP(+Y)=LRTP
34 I $L($P(^LAB(60,+Y,.1),U,5)) W !!?2,$P(^LAB(60,+Y,0),U)," has a specialized print routine",!?2," and must be selected by itself.",$C(7),! Q
35 S LRTEST(+Y)="" S:'LRTP LRONETST=""
36 Q
37SPEC Q:'$D(LRTP) W ! S LRTP="" F I=0:0 S LRTP=$O(LRTP(LRTP)) Q:LRTP="" W !,?20,$P(^LAB(60,LRTP,0),U),?40,$P(^LAB(61,LRTP(LRTP),0),U),?65,$P(^(0),U,2)
38 I $D(LRTP)=11 W !!,"Listed above are the site/specimens for 'UNIQUE COLLECTION SAMPLES'",!,"defined for the tests selected. To see reference ranges, a specific",!,"site/specimen must be selected."
39 K LRTP S LRTP=0
40TYPE W !!?3,"Specify specimen actually tested. Use BLOOD when Whole blood is tested;",!,"use SERUM when Serum is tested; etc. In doubt press the Return key."
41 K DIC("S") S LRONESPC="",DIC="^LAB(61,",DIC("A")="Select SITE/SPECIMEN: ANY//",DIC(0)="AEMOQ",LRTP=0 D ^DIC S:$D(DUOUT)!$D(DTOUT) LREND=1 Q:LREND S:Y>0 LRTP=+Y,LRONESPC=LRTP K DIC("A")
42 Q
43SPC ;from LRSOR1
44 D COAG
45 Q
Note: See TracBrowser for help on using the repository browser.