25 lines
1.3 KiB
Mathematica
25 lines
1.3 KiB
Mathematica
QAOSPSS1 ;HISC/DAD-OCCURRENCE SERVICE STATISTICS BY SERVICE ;9/14/92 10:46
|
|
;;3.0;Occurrence Screen;;09/14/1993
|
|
S QAOSQUIT=0,QAOSPAGE=1,X="T",%DT="" D ^%DT X ^DD("DD") S TODAY=Y K UNDL S $P(UNDL,"-",81)=""
|
|
F QAOSTYPE="N","L","1" Q:QAOSQUIT I $O(^UTILITY($J,"QAOSPSS",QAOSTYPE,""))]"" D HEAD S QAOSSERV="" F QAOSSERV(0)=0:0 S QAOSSERV=$O(^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSERV)) Q:QAOSSERV=""!QAOSQUIT D LOOP1
|
|
Q
|
|
LOOP1 ;
|
|
W !!,$S(QAOSSERV'["~":QAOSSERV,1:$E(QAOSSERV,2,999)) S QAOSRVT=0 F QAOSSEQ=0:0 S QAOSSEQ=$O(^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ)) Q:QAOSSEQ'>0!QAOSQUIT D LOOP2
|
|
I $E(IOST)="C",QAOSQUIT'>0,$O(^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSERV))="" D PAUSE
|
|
Q
|
|
LOOP2 ;
|
|
S QAOSTEMP=^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ) W !?5,QAOSSEQ,?20,+QAOSTEMP,?40,$J($P(QAOSTEMP,"^",2),4)
|
|
S QAOSRVT=QAOSRVT+$P(QAOSTEMP,"^",2)
|
|
I $O(^UTILITY($J,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ))'>0 W ?60,$J(QAOSRVT,6)
|
|
I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT D HEAD
|
|
Q
|
|
PAUSE ;
|
|
K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|
Q
|
|
HEAD ;
|
|
W:(QAOSPAGE>1)!($E(IOST)="C") @IOF
|
|
W !!?22,"OCCURRENCE SCREEN SERVICE STATISTICS",?68,TODAY
|
|
W !?QAQTART,QAQ2HED,?68,"PAGE: ",QAOSPAGE S QAOSPAGE=QAOSPAGE+1
|
|
W !!,"SERVICE",!?2,"CRITERION",?19,"SCREEN",?39,"FREQUENCY",?58,"SERVICE TOTAL",!,UNDL
|
|
Q
|