source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPAU0.m@ 1375

Last change on this file since 1375 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1QAOSPAU0 ;HISC/DAD-AUTO ENROLL RUN DATES REPORT ;6/11/93 15:55
2 ;;3.0;Occurrence Screen;;09/14/1993
3ASK W !!,"Include retired national screens"
4 S %=2 D YN^DICN G:%=-1 EXIT S QAOSINAC=$S(%=1:1,1:0) I '% D G ASK
5 . W !!?5,"Enter Y(es) to include the stats of retired national screens."
6 . W !?5,"Enter N(o) to display only the current national screens."
7 . Q
8 D ^QAQDATE G:QAQQUIT EXIT
9 K %ZIS,IOP S %ZIS="QM" D ^%ZIS G:POP EXIT
10 I $D(IO("Q")) D G EXIT
11 . S ZTRTN="ENTSK^QAOSPAU0",ZTDESC="Auto enroll run dates tally"
12 . S ZTSAVE("QAOS*")="",ZTSAVE("QAQ*")="" D ^%ZTLOAD
13 . Q
14ENTSK ;
15 S QAOSQUIT=0,PAGE=1,Y=DT X ^DD("DD") S TODAY=$P(Y,"@")
16 K UNDL S $P(UNDL,"-",80)="-" F QA=2:1:15 S QAOSTOT(QA)=0
17 S X=QAQNBEG D H^%DTC S START=%H,X=QAQNEND D H^%DTC S END=%H
18 U IO D HEAD
19 F QAOSDATE=START:1:END Q:QAOSQUIT D
20 . S %H=QAOSDATE D YMD^%DTC S QAOSDT=X
21 . S QAOSD0=$O(^QA(741.99,"B",QAOSDT,0)),Y=QAOSDT X ^DD("DD")
22 . W !!,$P(Y,"@")
23 . I QAOSD0'>0 W ?14,"*** AUTO ENROLL DID NOT RUN ON THIS DATE ***" G CHK
24 . S LOC=^QA(741.99,QAOSD0,0),TAB=12
25 . I QAOSINAC F PIECE=2,14,3:1:13,15 D PRINT
26 . E F PIECE=14,3,11,13,15 D PRINT
27CHK . I $Y>(IOSL-6)&(QAOSDATE'=END) D:$E(IOST)="C" PAUSE Q:QAOSQUIT D HEAD
28 . Q
29 G:QAOSQUIT EXIT
30 W !!,UNDL,!,"TOTALS:" S TAB=11
31 I QAOSINAC F QA=2,14,3:1:13,15 W ?TAB,$J(QAOSTOT(QA),4) S TAB=TAB+5
32 E F QA=14,3,11,13,15 W ?TAB,$J(QAOSTOT(QA),4) S TAB=TAB+5
33EXIT ;
34 W ! D ^%ZISC
35 K %H,%ZIS,END,LOC,PAGE,PIECE,POP,QA,QAOSD0,QAOSDATE,QAOSDT,QAOSINAC
36 K QAOSQUIT,QAOSTOT,START,TAB,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,ZTSAVE,%DT,%T
37 K D,I,Y,Z
38 D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
39 Q
40PRINT ;
41 S QA=$P(LOC,"^",PIECE),QA=$S(QA]"":QA,1:"???")
42 W ?TAB,$J(QA,3) S TAB=TAB+5,QAOSTOT(PIECE)=QAOSTOT(PIECE)+QA
43 Q
44HEAD ;
45 W:(PAGE>1)!($E(IOST)="C") @IOF
46 W !!?29,"ENROLLMENT DATES TALLY",?68,TODAY
47 W !?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1
48 I QAOSINAC W !!,"RUN 101.1 103 104.2 105.2 106.2 108 199",!,"DATE 101 102 104.1 105.1 106.1 107 109"
49 E W !!,"RUN 102 109",!,"DATE 101.1 107 199"
50 W !,UNDL Q
51PAUSE ;
52 K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
53 Q
Note: See TracBrowser for help on using the repository browser.