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

LRCS14S4.m

Go to the documentation of this file.
LRCS14S4 ;SLC/CJS- RCS 14 4 ; 6/2/86  7:46 AM ;
 ;;V~5.0~;LAB;;02/27/90 17:09
 K ^UTILITY("LRCSY"),^UTILITY("LRCS"),^UTILITY($J) S %DT="AEX",%DT("A")="RCS 14 4 STARTING DATE (EXCLUSIVE): " D ^%DT S LRFR=Y Q:Y<1
 S %DT("A")="RCS 14 4  ENDING  DATE (INCLUSIVE): " D ^%DT K %DT("A") S LRTO=Y Q:Y<1
 D ^%ZIS Q:POP  D:IO'=IO(0) EXIT S U="^" F F=0:0 S LRFR=$N(^LRO(69,LRFR)) Q:LRFR<1  D 1
 S LRLLOC=-1 F I=0:0 S LRLLOC=$N(^UTILITY("LRCS",LRLLOC)) Q:LRLLOC=-1  D X1
 F Y=0:0 S Y=$N(T(Y)) Q:Y<1  D Y
 S LRLLOC=-1 F F=0:0 S LRLLOC=$N(^UTILITY("LRCS",LRLLOC)) Q:LRLLOC=-1  D Y2
 U IO W @IOF S LRLLOC=-1 F F=0:0 S LRLLOC=$N(^UTILITY($J,LRLLOC)) Q:LRLLOC=-1  W !?5,LRLLOC D 2
 W @IOF,"TOTALS:" S T=-1 F X=0:0 S T=$N(^UTILITY("LRCSY",T)) Q:T=-1  S LRTTST=$P(T,"^",1),LRTNUM="",LRTNUM=$N(^LAM("B",LRTTST,LRTNUM)) W !,$P(T,"^",1),?22,^UTILITY("LRCSY",T) W:LRTNUM>0 ?28,^UTILITY("LRCSY",T)*$P(^LAM(LRTNUM,0),"^",3)
 Q
X1 F J=0:0 S J=$N(^UTILITY("LRCS",LRLLOC,J)) Q:J<1  S T(J)=^UTILITY("LRCS",LRLLOC,J)+$S($D(T(J)):T(J),1:0)
 Q
2 S LRTSTS=-1
 F X=0:0 S LRTSTS=$N(^UTILITY($J,LRLLOC,LRTSTS)) Q:LRTSTS=-1  D A2
 Q
A2 S LRWTST=$P(LRTSTS,"^",1),LRNUM="",LRNUM=$N(^LAM("B",LRWTST,LRNUM)) W !,$P(LRTSTS,"^",1),?22,^UTILITY($J,LRLLOC,LRTSTS) W:LRNUM>0 ?28,^UTILITY($J,LRLLOC,LRTSTS)*$P(^LAM(LRNUM,0),"^",3)
 Q
1 F DA=0:0 S DA=$N(^LRO(69,LRFR,1,DA)) Q:DA<1  D 4
 Q
4 Q:'$D(^LRO(69,LRFR,1,DA,0))  S LRLLOC=$E($P(^(0),"^",7),1,20),LRLLOC=$S($L(LRLLOC):LRLLOC,1:"NONE") F T=0:0 S T=$N(^LRO(69,LRFR,1,DA,2,T)) Q:T<1  D 5
 Q
5 S LRTSTS=+^LRO(69,LRFR,1,DA,2,T,0),^UTILITY("LRCS",LRLLOC,LRTSTS)=1+$S($D(^UTILITY("LRCS",LRLLOC,LRTSTS)):^UTILITY("LRCS",LRLLOC,LRTSTS),1:0)
 Q
Y S LRTN=$E($S($D(^LAB(60,Y,0)):$P(^(0),"^",1),1:"Deleted test"),1,20)_"^"_Y,^UTILITY("LRCSY",LRTN)=T(Y) K T(Y) Q
Y2 F LRTSTS=0:0 S LRTSTS=$N(^UTILITY("LRCS",LRLLOC,LRTSTS)) Q:LRTSTS<1  S LRTN=$E($S($D(^LAB(60,LRTSTS,0)):$P(^(0),"^",1),1:"Deleted test"),1,20)_"^"_LRTSTS,^UTILITY($J,LRLLOC,LRTN)=^UTILITY("LRCS",LRLLOC,LRTSTS)
 Q
EXIT K %DT,DA,F,I,J,LRCOL,LRFR,LRLLOC,LRNUM,LRTN,LRTNUM,LRTO,LRTSTS,LRTTST,LRWTST,POP,T,X,Y
 X ^%ZIS("C") Q