source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRGEN2.m@ 808

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