- 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 Mar 13, 2025@21:26:59 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
