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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSPSS1 1333 printed Dec 13, 2024@02:22:02 Page 2
QAOSPSS1 ;HISC/DAD-OCCURRENCE SERVICE STATISTICS BY SERVICE ;9/14/92 10:46
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 SET QAOSQUIT=0
SET QAOSPAGE=1
SET X="T"
SET %DT=""
DO ^%DT
XECUTE ^DD("DD")
SET TODAY=Y
KILL UNDL
SET $PIECE(UNDL,"-",81)=""
+3 FOR QAOSTYPE="N","L","1"
if QAOSQUIT
QUIT
IF $ORDER(^UTILITY($JOB,"QAOSPSS",QAOSTYPE,""))]""
DO HEAD
SET QAOSSERV=""
FOR QAOSSERV(0)=0:0
SET QAOSSERV=$ORDER(^UTILITY($JOB,"QAOSPSS",QAOSTYPE,QAOSSERV))
if QAOSSERV=""!QAOSQUIT
QUIT
DO LOOP1
+4 QUIT
LOOP1 ;
+1 WRITE !!,$SELECT(QAOSSERV'["~":QAOSSERV,1:$EXTRACT(QAOSSERV,2,999))
SET QAOSRVT=0
FOR QAOSSEQ=0:0
SET QAOSSEQ=$ORDER(^UTILITY($JOB,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ))
if QAOSSEQ'>0!QAOSQUIT
QUIT
DO LOOP2
+2 IF $EXTRACT(IOST)="C"
IF QAOSQUIT'>0
IF $ORDER(^UTILITY($JOB,"QAOSPSS",QAOSTYPE,QAOSSERV))=""
DO PAUSE
+3 QUIT
LOOP2 ;
+1 SET QAOSTEMP=^UTILITY($JOB,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ)
WRITE !?5,QAOSSEQ,?20,+QAOSTEMP,?40,$JUSTIFY($PIECE(QAOSTEMP,"^",2),4)
+2 SET QAOSRVT=QAOSRVT+$PIECE(QAOSTEMP,"^",2)
+3 IF $ORDER(^UTILITY($JOB,"QAOSPSS",QAOSTYPE,QAOSSERV,QAOSSEQ))'>0
WRITE ?60,$JUSTIFY(QAOSRVT,6)
+4 IF $Y>(IOSL-6)
if $EXTRACT(IOST)="C"
DO PAUSE
if QAOSQUIT
QUIT
DO HEAD
+5 QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
+2 QUIT
HEAD ;
+1 if (QAOSPAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?22,"OCCURRENCE SCREEN SERVICE STATISTICS",?68,TODAY
+3 WRITE !?QAQTART,QAQ2HED,?68,"PAGE: ",QAOSPAGE
SET QAOSPAGE=QAOSPAGE+1
+4 WRITE !!,"SERVICE",!?2,"CRITERION",?19,"SCREEN",?39,"FREQUENCY",?58,"SERVICE TOTAL",!,UNDL
+5 QUIT
