QAOSPSM.m

QAOSPSM ;HISC/DAD-SUMMARY OF OCCURRENCE SCREENING - DRIVER ;6/11/93  15:58

 ;;3.0;Occurrence Screen;;09/14/1993

EN1 ; Automatically print medical center, reporting period, criteria auto

 ; enrolled, computer program used, number of times an action was

 ; taken, and service specific occurrences

 S QAOBLANK=0 G ASKSCR

EN2 ; Print a totally blank report

 S QAOBLANK=1

ASKSCR ;

 K DIR S DIR(0)="LO^1:3^K:X[""."" X"

 S DIR("A")="Select screen criteria to include"

 S DIR("B")=1,DIR("?",1)="Choose from:",DIR("?",2)="  1   National"

 S DIR("?",3)="  2   Local",DIR("?",4)="  3   Inactive"

 S DIR("?")="Select any combination of the codes listed above, e.g. 1-3, 1,2"

 W ! D ^DIR G:$D(DIRUT) EXIT S QAOSLIST(0)=Y

ASKPRT2 ;

 W !!,"Print PART II of the Summary of Occurrence Screening"

 S %=2 D YN^DICN G:%=-1 EXIT S QAOPART2=$S(%=1:1,1:0)

 I '% W !!?5,"Please answer Y(es) or N(o)" G ASKPRT2

ASKPEND ;

 I QAOBLANK S QAOSPEND=0 G ASKDATE

 W !!,"Print a list of all PENDING occurrences"

 S %=2 D YN^DICN G:%=-1 EXIT S QAOSPEND=$S(%=1:1,1:0)

 I '% W !!?5,"Please answer Y(es) or N(o)" G ASKPEND

ASKDATE ;

 W !!,"Select the reporting period:"

 S QAQDATE="Semi-Annually" D ^QAQDATE G:QAQQUIT EXIT

ASKDEV ;

 K %ZIS S %ZIS="QM" D ^%ZIS G:POP EXIT

 I $D(IO("Q")) K IO("Q") D  G EXIT

 . S ZTRTN="ENTSK^QAOSPSM"

 . S (ZTSAVE("QAQ*"),ZTSAVE("QAO*"))=""

 . S ZTDESC="Occurrence Screen Semi-Annual Report"

 . D ^%ZTLOAD

 . Q

ENTSK ;

 K ^UTILITY($J) D ^QAOSPSM0 U IO D ^QAOSPSM1

 I QAOSQUIT'>0,QAOPART2 D ^QAOSPSM2

 I QAOSQUIT'>0,QAOSPEND D ^QAOSPSM5

EXIT ;

 W ! D ^%ZISC K TAB,UNDL,X,Y,ZTRTN,ZTSAVE D K^QAQDATE

 K %ZIS,DIR,DIRUT,POP,QA,QAO,QAOPART2,QAOS,QAOSACTN,QAOSCLIN,QAOSCREV

 K QAOSD0,QAOSD1,QAOSDATE,QAOSFIND,QAOSKIND,QAOSLEVL,QAOSLIST,QAOSLST

 K QAOSMGMT,QAOSNUM,QAOSQUIT,QAOSRFPR,QAOSSCRN,QAOSSEQ,QAOSSITE,QAOSSTAT

 K QAOSTEMP,QAOSZERO,QAOBLANK,QAOSCRN,QAOSPEER,QAOSS1,QAOSS2,QAOSPEND

 K %,%H,QAOSDPT,QAOSPAGE,QAOSPAT,QAOSSN,TODAY,QAOFINAL,QAOSHOSP,QAOSRV

 K QAOSWARD,SERV

 K ^UTILITY($J,"QAOSPSM"),^UTILITY($J,"QAOSXREF"),^UTILITY($J,"QAOSPEND")

 S:$D(ZTQUEUED) ZTREQ="@"

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAOSPSM   2116     printed  Apr 09, 2024@21:23:01                                                                                                                                                                                                     Page 2

QAOSPSM   ;HISC/DAD-SUMMARY OF OCCURRENCE SCREENING - DRIVER ;6/11/93  15:58

 +1       ;;3.0;Occurrence Screen;;09/14/1993

EN1       ; Automatically print medical center, reporting period, criteria auto

 +1       ; enrolled, computer program used, number of times an action was

 +2       ; taken, and service specific occurrences

 +3        SET QAOBLANK=0

           GOTO ASKSCR

EN2       ; Print a totally blank report

 +1        SET QAOBLANK=1

ASKSCR    ;

 +1        KILL DIR

           SET DIR(0)="LO^1:3^K:X[""."" X"

 +2        SET DIR("A")="Select screen criteria to include"

 +3        SET DIR("B")=1

           SET DIR("?",1)="Choose from:"

           SET DIR("?",2)="  1   National"

 +4        SET DIR("?",3)="  2   Local"

           SET DIR("?",4)="  3   Inactive"

 +5        SET DIR("?")="Select any combination of the codes listed above, e.g. 1-3, 1,2"

 +6        WRITE !

           DO ^DIR

           if $DATA(DIRUT)

               GOTO EXIT

           SET QAOSLIST(0)=Y

ASKPRT2   ;

 +1        WRITE !!,"Print PART II of the Summary of Occurrence Screening"

 +2        SET %=2

           DO YN^DICN

           if %=-1

               GOTO EXIT

           SET QAOPART2=$SELECT(%=1:1,1:0)

 +3        IF '%

               WRITE !!?5,"Please answer Y(es) or N(o)"

               GOTO ASKPRT2

ASKPEND   ;

 +1        IF QAOBLANK

               SET QAOSPEND=0

               GOTO ASKDATE

 +2        WRITE !!,"Print a list of all PENDING occurrences"

 +3        SET %=2

           DO YN^DICN

           if %=-1

               GOTO EXIT

           SET QAOSPEND=$SELECT(%=1:1,1:0)

 +4        IF '%

               WRITE !!?5,"Please answer Y(es) or N(o)"

               GOTO ASKPEND

ASKDATE   ;

 +1        WRITE !!,"Select the reporting period:"

 +2        SET QAQDATE="Semi-Annually"

           DO ^QAQDATE

           if QAQQUIT

               GOTO EXIT

ASKDEV    ;

 +1        KILL %ZIS

           SET %ZIS="QM"

           DO ^%ZIS

           if POP

               GOTO EXIT

 +2        IF $DATA(IO("Q"))

               KILL IO("Q")

               Begin DoDot:1

 +3                SET ZTRTN="ENTSK^QAOSPSM"

 +4                SET (ZTSAVE("QAQ*"),ZTSAVE("QAO*"))=""

 +5                SET ZTDESC="Occurrence Screen Semi-Annual Report"

 +6                DO ^%ZTLOAD

 +7                QUIT 

               End DoDot:1

               GOTO EXIT

ENTSK     ;

 +1        KILL ^UTILITY($JOB)

           DO ^QAOSPSM0

           USE IO

           DO ^QAOSPSM1

 +2        IF QAOSQUIT'>0

               IF QAOPART2

                   DO ^QAOSPSM2

 +3        IF QAOSQUIT'>0

               IF QAOSPEND

                   DO ^QAOSPSM5

EXIT      ;

 +1        WRITE !

           DO ^%ZISC

           KILL TAB,UNDL,X,Y,ZTRTN,ZTSAVE

           DO K^QAQDATE

 +2        KILL %ZIS,DIR,DIRUT,POP,QA,QAO,QAOPART2,QAOS,QAOSACTN,QAOSCLIN,QAOSCREV

 +3        KILL QAOSD0,QAOSD1,QAOSDATE,QAOSFIND,QAOSKIND,QAOSLEVL,QAOSLIST,QAOSLST

 +4        KILL QAOSMGMT,QAOSNUM,QAOSQUIT,QAOSRFPR,QAOSSCRN,QAOSSEQ,QAOSSITE,QAOSSTAT

 +5        KILL QAOSTEMP,QAOSZERO,QAOBLANK,QAOSCRN,QAOSPEER,QAOSS1,QAOSS2,QAOSPEND

 +6        KILL %,%H,QAOSDPT,QAOSPAGE,QAOSPAT,QAOSSN,TODAY,QAOFINAL,QAOSHOSP,QAOSRV

 +7        KILL QAOSWARD,SERV

 +8        KILL ^UTILITY($JOB,"QAOSPSM"),^UTILITY($JOB,"QAOSXREF"),^UTILITY($JOB,"QAOSPEND")

 +9        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +10       QUIT