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 ---[H[J[2J[HQAOSPSM 2116 printed Nov 22, 2024@17:31:52 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
