QAOSPSS1.m

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 ---QAOSPSS1   1333     printed  Apr 09, 2024@21:22:53                                                                                                                                                                                                    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