©2011-2018 Open Source Electronic Health Record Alliance
This work is licensed under a Creative Commons Attribution 3.0 Unported License
This work is licensed under a Creative Commons Attribution 3.0 Unported License
LRCS14S5 ;SLC/CJS- RCS 14 4 (CONT.) ; 6/2/86 7:47 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,?22,"Total",?30,"Uncollected",?44,"Collected",?56,"Time" S LRLLOC=-1 F F=0:0 S LRLLOC=$N(^UTILITY($J,LRLLOC)) Q:LRLLOC=-1 W !?5,LRLLOC D 2
W @IOF,"TOTALS:",?22,"Total",?30,"Uncollected",?44,"Collected",?56,"Time" 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)) D TOTS
Q
TOTS W !,$P(T,"^",1),?24,^UTILITY("LRCSY",T) W:$D(^UTILITY("LRCSY",T,"UCOL")) ?35,^UTILITY("LRCSY",T,"UCOL") W:$D(^UTILITY("LRCSY",T,"COL")) ?48,^UTILITY("LRCSY",T,"COL")
W:(LRTNUM>0)&($D(^UTILITY("LRCSY",T,"COL"))) ?57,^UTILITY("LRCSY",T,"COL")*$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) D X2
X2 S:$D(^UTILITY("LRCS",LRLLOC,J,"COL")) T(J,"COL")=^UTILITY("LRCS",LRLLOC,J,"COL")+$S($D(T(J,"COL")):T(J,"COL"),1:0) S:$D(^UTILITY("LRCS",LRLLOC,J,"UCOL")) T(J,"UCOL")=^UTILITY("LRCS",LRLLOC,J,"UCOL")+$S($D(T(J,"UCOL")):T(J,"UCOL"),1:0) Q
Q
2 S LRTSTS=-1 F X=0:0 S LRTSTS=$N(^UTILITY($J,LRLLOC,LRTSTS)) Q:LRTSTS=-1 S LRWTST=$P(LRTSTS,"^",1),LRNUM="",LRNUM=$N(^LAM("B",LRWTST,LRNUM)) D 21
Q
21 W !,$P(LRTSTS,"^",1),?24,^UTILITY($J,LRLLOC,LRTSTS) W:$D(^UTILITY("LRCS",LRLLOC,$P(LRTSTS,U,2),"UCOL")) ?35,^UTILITY("LRCS",LRLLOC,$P(LRTSTS,U,2),"UCOL")
W:$D(^UTILITY("LRCS",LRLLOC,$P(LRTSTS,U,2),"COL")) ?48,^UTILITY("LRCS",LRLLOC,$P(LRTSTS,U,2),"COL") W:LRNUM>0&$D(^UTILITY("LRCS",LRLLOC,$P(LRTSTS,U,2),"COL")) ?57,^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)
S LRCOL="" I $D(^LRO(69,LRFR,1,DA,1)) S:$L($P(^LRO(69,LRFR,1,DA,1),U,4)) LRCOL=$P(^LRO(69,LRFR,1,DA,1),U,4) S:LRCOL="C" ^UTILITY("LRCS",LRLLOC,LRTSTS,"COL")=1+$S($D(^UTILITY("LRCS",LRLLOC,LRTSTS,"COL")):^UTILITY("LRCS",LRLLOC,LRTSTS,"COL"),1:0)
S:LRCOL'="C" ^UTILITY("LRCS",LRLLOC,LRTSTS,"UCOL")=1+$S($D(^UTILITY("LRCS",LRLLOC,LRTSTS,"UCOL")):^UTILITY("LRCS",LRLLOC,LRTSTS,"UCOL"),1:0)
Q
Y S LRTN=$E($P(^LAB(60,Y,0),"^",1),1,20)_"^"_Y,^UTILITY("LRCSY",LRTN)=T(Y) S:$D(T(Y,"COL")) ^UTILITY("LRCSY",LRTN,"COL")=T(Y,"COL") S:$D(T(Y,"UCOL")) ^UTILITY("LRCSY",LRTN,"UCOL")=T(Y,"UCOL") K T(Y),T(Y,"COL"),T(Y,"UCOL") Q
Y2 F LRTSTS=0:0 S LRTSTS=$N(^UTILITY("LRCS",LRLLOC,LRTSTS)) Q:LRTSTS<1 S LRTN=$E($P(^LAB(60,LRTSTS,0),"^",1),1,20)_"^"_LRTSTS,^UTILITY($J,LRLLOC,LRTN)=^UTILITY("LRCS",LRLLOC,LRTSTS)
Q
EXIT X ^%ZIS("C") K ^UTILITY("LRCSY"),^UTILITY("LRCS"),^UTILITY($J) Q