©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
LRCAPS2 ;SLC/DCM- CAP STATISTICS SUMMARY PRINT ; 2/6/89 11:54 ;
;;V~5.0~;LAB;;02/27/90 17:09
S (LRPG,LRSITE)=0 F II=0:0 S LRSITE=$O(^UTILITY($J,LRSITE)) Q:LRSITE<1 S LRSTA=$S($D(^DIC(4,LRSITE,0)):$P(^(0),"^"),1:"STATION #"_LRSITE) D MAJ Q:LREND
D:'LREND WAIT W @IOF K LRPG,LRSITE,LRMAJ,KK,LL,LRSB,T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12,M,MM,XX,X2,X3,X1,X4,X6,X7,X8,X9,X10,X11,X12,LRCL
Q
MAJ S LRMAJ=0 F JJ=0:0 S LRMAJ=$O(^UTILITY($J,LRSITE,LRMAJ)) Q:LRMAJ="" D SEC Q:LREND
Q
SEC F KK=0:0 S KK=$N(^UTILITY($J,LRSITE,LRMAJ,KK)) Q:KK<1 S LRSEC=$S($D(^LAB(62.2,KK,0)):$P(^(0),U,1),1:"SECTION #"_KK) D HEAD,SUB Q:LREND
Q
SUB F LL=0:0 S LL=$N(^UTILITY($J,LRSITE,LRMAJ,KK,LL)) Q:LL<1 S LRSB=$S($D(^LAB(62.2,LL,0)):$P(^(0),U,1),1:"SUB-SECTION #"_LL),(T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,T11,T12)=0 D HEAD1,TEST,TOT Q:LREND
Q
TEST S MM="" F M=0:0 S MM=$O(^UTILITY($J,LRSITE,LRMAJ,KK,LL,MM)) Q:MM="" S X=^(MM) D PRINT Q:LREND
Q
PRINT S XX=+X,X1=$P(X,"^",2),X2=$S(XX:XX*X1,1:0),X3=$P(X,"^",3),X4=$P(X,"^",4),X5=$S(XX:X4*XX,1:0),X6=$P(X,"^",5),X7=$P(X,"^",6),X8=$S(XX:X7*XX,1:0),X9=$P(X,"^",7)+$P(X,"^",8),X10=$S(XX:XX*X9,1:0)
S X11=$P(X,"^",9),X12=$S(XX:XX*X11,1:0)
S T1=T1+X1,T2=T2+X2,T3=T3+X3,T4=T4+X4,T5=T5+X5,T6=T6+X6,T7=T7+X7,T8=T8+X8,T9=T9+X9,T10=T10+X10,T11=T11+X11,T12=T12+X12
I $Y>(IOSL-7) D DASH^LRX W !!?(IOM-14),"Continued..." D WAIT Q:LREND D HEAD,HEAD1
W !,$E(MM,1,30),?31,$J("["_XX_"]",6),$J(X1,8),$J(X2,8),$J(X3,8),$J(X4,10),$J(X5,8),$J(X6,8),$J(X7,7),$J(X8,6),$J(X9,6),$J(X10,6),$J(X11,9),$J(X12,10)
Q
HEAD ;from LRCAPW2
W @IOF S LRPG=LRPG+1,%DT="T",X="N" D ^%DT X ^DD("DD") W !,Y S LRCL=IOM\2-($L(LRSTA)\2) W ?LRCL,LRSTA,?(IOM-9),"PAGE ",LRPG
S LRCL=IOM\2-10 W !?LRCL,"CAP STATISTICS REPORT"
S LRCL=IOM\2-($L(LRSEC)\2) W !?LRCL,LRSEC
S LRCL=IOM\2-(6+$L(LRH1)+$L(LRH2)\2) W !?LRCL,LRH1," thru ",LRH2
D DASH^LRX
W !?32,"|",?37,"| I N P A T I E N T S | O U T P A T I E N T S | OTHER | QC & | TOTAL"
W !?32,"|",?37,"|",?46,"ALL",?56,"STATS |",?71,"ALL",?82,"STATS | | REPEATS |"
W !,$S('$D(LRWORK):"PROCEDURE",1:"SUBSECTIONS"),?32,"|",?37,"|------------------------|-------------------------|-----------|-----------|------------------"
W !?32,$S($D(LRWORK):"| |",1:"|[UW]|")," COUNT UNITS | COUNT | COUNT UNITS | COUNT |COUNT UNITS|COUNT UNITS| COUNT UNITS"
Q
HEAD1 ;from LRCAPW2
W !
W LRSB
D DASH^LRX
Q
TOT W !?23,"SUBTOTAL",?37,$J(T1,8),$J(T2,8),$J(T3,8),$J(T4,10),$J(T5,8),$J(T6,8),$J(T7,7),$J(T8,6),$J(T9,6),$J(T10,6),$J(T11,9),$J(T12,10)
D EQUALS^LRX
Q
WAIT ;from LRCAPW2
I IOST["C-" W !,"...Press RETURN to continue, '^' to stop..." R X:DTIME I X="^" S LREND=1
Q