LRGEN2 ;SLC/RWF-CUMULATIVE REPORT FOR SELECTED TESTS ;8/25/87 08:35 ;;5.2;LAB SERVICE;**121,153,221**;Sep 27, 1994 TESTS ;from LRGEN N LRCUTE 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 I $L($P(^LAB(60,+Y,.1),U,5)) S LRCUTE=$P(^(.1),U,4,5) K DIC("S") D Q . I $G(LRDONT) D LRTP S (LRIX,LRTSTS,LRPRETTY)=1,LRTEST(+LRONETST)=LRCUTE Q . D @LRCUTE S LRTSTS=0 Q ;pretty print routine D LRTP F I=0:0 D ^DIC Q:Y<0 S LRONETST="" D LRTP D:'LRONETST SPEC Q:LREND I LRONETST S Y=+$O(LRTEST(0)) D LRTP D:'LRTP TYPE Q:LREND 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:"""")" S LRTEST=0 F I=0:0 S LRTEST=+$O(LRTEST(LRTEST)) Q:LRTEST<1 S LREXPD=LRXPD D ^LREXPD COAG 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 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 I LRTN<0 W !!,$C(7),"TEST NOT IMPLEMENTED" Q S:'$L($G(SEX)) SEX="M" S:'$L($G(AGE)) AGE=99 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 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 K ^TMP("LR",$J,"TMP"),DIC,LRUT S LRHDR="" Q MUSH I '$D(^XUSEC("LRLAB",DUZ)),"BO"'[$P(^LAB(60,LRORD(LRORD),0),U,3) Q S X=^TMP("LR",$J,"TMP",LRTN),LRSUB=$P(LRTN,";",1) I LRPS'=LRSUB D:LRIX(LRIX)'=LRSSP PUSH S LRSUB(LRIX)=LRSUB,LRPS=LRSUB 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) 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) 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 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:" ") I LRSSP-LRIX(LRIX)#6=0 D PUSH S LRSUB(LRIX)=LRSUB,LRPS=LRSUB Q PUSH 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 Q LRTP S LRTP="" 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 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 S LRTEST(+Y)="" S:'LRTP LRONETST="" Q SPEC 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) 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." K LRTP S LRTP=0 TYPE 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." 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") Q SPC ;from LRSOR1 D COAG Q