Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRACS3

LRACS3.m

Go to the documentation of this file.
LRACS3 ;SLC/DCM - MISCELLANEOUS TESTS FOR SUPERVISORS SUMMARY ; 6/11/87  13:38 ;
 ;;5.2;LAB SERVICE;**201,225**;Sep 27, 1994
ENT D HEAD S LRXLR="LRAC",LRHEAD2=0,LRLLOC="",LRSORT=$S($D(^LAB(64.5,1,4)):$P(^(4),U,1),1:""),LRMIC="" I '$D(^TMP($J,LRDT,"NOKILL")) K ^TMP($J) S ^TMP($J,LRDT,"NOKILL")="" D LRLLOC
 D:LRSORT SORT^LRACS2 D EQUALS^LRX W @IOF D END Q
LRLLOC F I=0:0 S LRLLOC=$O(^LRO(69,LRDT,1,"AR",LRLLOC)) Q:LRLLOC=""  S LRNM="" D:$Y>(IOSL-10) HEAD D HEAD1,LRNM
 Q
LRNM F J=0:0 S LRNM=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM)) Q:LRNM=""  D LRDFN
 Q
LRDFN S LRDFN=0 F  S LRDFN=$O(^LRO(69,LRDT,1,"AR",LRLLOC,LRNM,LRDFN)) Q:LRDFN<1!('$D(^LAC(LRXLR,+$G(LRDFN))))  S LRHEAD2=0 S:LRSORT ^TMP($J,LRNM,LRDFN)="" D:'LRSORT LRIDT
 Q
LRIDT S LRDPF=$P(^LR(LRDFN,0),"^",2),DFN=$P(^(0),"^",3) D PT^LRX
 Q:'$D(^LAC(LRXLR,LRDFN,"MISC",1,0))  S Z=^LAC(LRXLR,LRDFN,0)
 S LRIDT=0 F  S LRIDT=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIDT)) Q:LRIDT<1  S Z=^(LRIDT,0) D LRIFN
 Q
LRIFN S LRVIDT=$P(Z,U,2),LRVDT=$P(Z,U,3) Q:LRVDT>(LRDT_.9999)!(LRVDT<LRLDT)  S LRLOG=$P(Z,U,4),LRSPM=$P(Z,U,5),LRSPM=$S($L(LRSPM):$E($P(^LAB(61,LRSPM,0),U,1),1,7),1:LRSPM)
 I LRHEAD2=0 D LRHEAD2 S LRHEAD2=1
 S LRCL=2,Y=LRVIDT S Y=$$Y2K^LRX(Y) D:$Y>(IOSL-10) HEAD,HEAD1,LRHEAD2 W !,Y,?18,LRLOG,"   ",LRSPM,"   ",!?LRCL
 S LRIFN=0 F  S LRIFN=$O(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIDT,1,LRIFN)) Q:'LRIFN  S Z=^(LRIFN,0),LRVAL=$P(Z,U,1),LRTST=$P(Z,U,3),X1=$P(Z,U,4),LRTST=$P(^LAB(60,LRTST,.1),U,1) D WRITE
 I $D(^LAC(LRXLR,LRDFN,"MISC",1,1,LRIDT,"TX",0)) S K=0 F  S K=$O(^LAC(LRXLR,LRDFN,"MISC",1,LRIDT,"TX",K)) Q:'K  W !?2,^(K,0)
 W ! Q
WRITE ;;W:$X>(IOM-19) !?LRCL S LRCL=LRCL+19 W "  ",$J(LRTST,7),": ",LRVAL," ",?LRCL S LRCL=$S(LRCL>(IOM-19):2,1:LRCL) ;;**Horizontal mess**
 W ?15,$J(LRTST,7),": ",LRVAL,! ;;**Vertical**
 Q
 Q
HEAD1 Q:'LRSORT  W !!?15,"*** "_LRLLOC_" ***"
 Q
LRHEAD2 D DASH^LRX W !!,PNM," ",?25,SSN_" ",?40,AGE,!
 Q
END K LRAG,LRCL,LRDFN,LRDT,LRHEAD2,LRIDT,LRIFN,LRIL,LRLDT,LRLLOC,LRLOG,LRMIC,LRMISC,LRNAME,LRNM,LRPG,LRPNM,LRSORT,LRSPM,LRTST,LRVAL,LRVDT,LRVIDT,LRXLR,LRYESCOM,SSN,X1,Y,Z,ZTRTN
 Q