| 1 | QAOSPSM ;HISC/DAD-SUMMARY OF OCCURRENCE SCREENING - DRIVER ;6/11/93 15:58
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | EN1 ; Automatically print medical center, reporting period, criteria auto
|
|---|
| 4 | ; enrolled, computer program used, number of times an action was
|
|---|
| 5 | ; taken, and service specific occurrences
|
|---|
| 6 | S QAOBLANK=0 G ASKSCR
|
|---|
| 7 | EN2 ; Print a totally blank report
|
|---|
| 8 | S QAOBLANK=1
|
|---|
| 9 | ASKSCR ;
|
|---|
| 10 | K DIR S DIR(0)="LO^1:3^K:X[""."" X"
|
|---|
| 11 | S DIR("A")="Select screen criteria to include"
|
|---|
| 12 | S DIR("B")=1,DIR("?",1)="Choose from:",DIR("?",2)=" 1 National"
|
|---|
| 13 | S DIR("?",3)=" 2 Local",DIR("?",4)=" 3 Inactive"
|
|---|
| 14 | S DIR("?")="Select any combination of the codes listed above, e.g. 1-3, 1,2"
|
|---|
| 15 | W ! D ^DIR G:$D(DIRUT) EXIT S QAOSLIST(0)=Y
|
|---|
| 16 | ASKPRT2 ;
|
|---|
| 17 | W !!,"Print PART II of the Summary of Occurrence Screening"
|
|---|
| 18 | S %=2 D YN^DICN G:%=-1 EXIT S QAOPART2=$S(%=1:1,1:0)
|
|---|
| 19 | I '% W !!?5,"Please answer Y(es) or N(o)" G ASKPRT2
|
|---|
| 20 | ASKPEND ;
|
|---|
| 21 | I QAOBLANK S QAOSPEND=0 G ASKDATE
|
|---|
| 22 | W !!,"Print a list of all PENDING occurrences"
|
|---|
| 23 | S %=2 D YN^DICN G:%=-1 EXIT S QAOSPEND=$S(%=1:1,1:0)
|
|---|
| 24 | I '% W !!?5,"Please answer Y(es) or N(o)" G ASKPEND
|
|---|
| 25 | ASKDATE ;
|
|---|
| 26 | W !!,"Select the reporting period:"
|
|---|
| 27 | S QAQDATE="Semi-Annually" D ^QAQDATE G:QAQQUIT EXIT
|
|---|
| 28 | ASKDEV ;
|
|---|
| 29 | K %ZIS S %ZIS="QM" D ^%ZIS G:POP EXIT
|
|---|
| 30 | I $D(IO("Q")) K IO("Q") D G EXIT
|
|---|
| 31 | . S ZTRTN="ENTSK^QAOSPSM"
|
|---|
| 32 | . S (ZTSAVE("QAQ*"),ZTSAVE("QAO*"))=""
|
|---|
| 33 | . S ZTDESC="Occurrence Screen Semi-Annual Report"
|
|---|
| 34 | . D ^%ZTLOAD
|
|---|
| 35 | . Q
|
|---|
| 36 | ENTSK ;
|
|---|
| 37 | K ^UTILITY($J) D ^QAOSPSM0 U IO D ^QAOSPSM1
|
|---|
| 38 | I QAOSQUIT'>0,QAOPART2 D ^QAOSPSM2
|
|---|
| 39 | I QAOSQUIT'>0,QAOSPEND D ^QAOSPSM5
|
|---|
| 40 | EXIT ;
|
|---|
| 41 | W ! D ^%ZISC K TAB,UNDL,X,Y,ZTRTN,ZTSAVE D K^QAQDATE
|
|---|
| 42 | K %ZIS,DIR,DIRUT,POP,QA,QAO,QAOPART2,QAOS,QAOSACTN,QAOSCLIN,QAOSCREV
|
|---|
| 43 | K QAOSD0,QAOSD1,QAOSDATE,QAOSFIND,QAOSKIND,QAOSLEVL,QAOSLIST,QAOSLST
|
|---|
| 44 | K QAOSMGMT,QAOSNUM,QAOSQUIT,QAOSRFPR,QAOSSCRN,QAOSSEQ,QAOSSITE,QAOSSTAT
|
|---|
| 45 | K QAOSTEMP,QAOSZERO,QAOBLANK,QAOSCRN,QAOSPEER,QAOSS1,QAOSS2,QAOSPEND
|
|---|
| 46 | K %,%H,QAOSDPT,QAOSPAGE,QAOSPAT,QAOSSN,TODAY,QAOFINAL,QAOSHOSP,QAOSRV
|
|---|
| 47 | K QAOSWARD,SERV
|
|---|
| 48 | K ^UTILITY($J,"QAOSPSM"),^UTILITY($J,"QAOSXREF"),^UTILITY($J,"QAOSPEND")
|
|---|
| 49 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 50 | Q
|
|---|
