QAOSPAU0 ;HISC/DAD-AUTO ENROLL RUN DATES REPORT ;6/11/93 15:55
;;3.0;Occurrence Screen;;09/14/1993
ASK W !!,"Include retired national screens"
S %=2 D YN^DICN G:%=-1 EXIT S QAOSINAC=$S(%=1:1,1:0) I '% D G ASK
. W !!?5,"Enter Y(es) to include the stats of retired national screens."
. W !?5,"Enter N(o) to display only the current national screens."
. Q
D ^QAQDATE G:QAQQUIT EXIT
K %ZIS,IOP S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="ENTSK^QAOSPAU0",ZTDESC="Auto enroll run dates tally"
. S ZTSAVE("QAOS*")="",ZTSAVE("QAQ*")="" D ^%ZTLOAD
. Q
ENTSK ;
S QAOSQUIT=0,PAGE=1,Y=DT X ^DD("DD") S TODAY=$P(Y,"@")
K UNDL S $P(UNDL,"-",80)="-" F QA=2:1:15 S QAOSTOT(QA)=0
S X=QAQNBEG D H^%DTC S START=%H,X=QAQNEND D H^%DTC S END=%H
U IO D HEAD
F QAOSDATE=START:1:END Q:QAOSQUIT D
. S %H=QAOSDATE D YMD^%DTC S QAOSDT=X
. S QAOSD0=$O(^QA(741.99,"B",QAOSDT,0)),Y=QAOSDT X ^DD("DD")
. W !!,$P(Y,"@")
. I QAOSD0'>0 W ?14,"*** AUTO ENROLL DID NOT RUN ON THIS DATE ***" G CHK
. S LOC=^QA(741.99,QAOSD0,0),TAB=12
. I QAOSINAC F PIECE=2,14,3:1:13,15 D PRINT
. E F PIECE=14,3,11,13,15 D PRINT
CHK . I $Y>(IOSL-6)&(QAOSDATE'=END) D:$E(IOST)="C" PAUSE Q:QAOSQUIT D HEAD
. Q
G:QAOSQUIT EXIT
W !!,UNDL,!,"TOTALS:" S TAB=11
I QAOSINAC F QA=2,14,3:1:13,15 W ?TAB,$J(QAOSTOT(QA),4) S TAB=TAB+5
E F QA=14,3,11,13,15 W ?TAB,$J(QAOSTOT(QA),4) S TAB=TAB+5
EXIT ;
W ! D ^%ZISC
K %H,%ZIS,END,LOC,PAGE,PIECE,POP,QA,QAOSD0,QAOSDATE,QAOSDT,QAOSINAC
K QAOSQUIT,QAOSTOT,START,TAB,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,ZTSAVE,%DT,%T
K D,I,Y,Z
D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
Q
PRINT ;
S QA=$P(LOC,"^",PIECE),QA=$S(QA]"":QA,1:"???")
W ?TAB,$J(QA,3) S TAB=TAB+5,QAOSTOT(PIECE)=QAOSTOT(PIECE)+QA
Q
HEAD ;
W:(PAGE>1)!($E(IOST)="C") @IOF
W !!?29,"ENROLLMENT DATES TALLY",?68,TODAY
W !?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1
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"
E W !!,"RUN 102 109",!,"DATE 101.1 107 199"
W !,UNDL Q
PAUSE ;
K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSPAU0 2250 printed Dec 13, 2024@02:21:36 Page 2
QAOSPAU0 ;HISC/DAD-AUTO ENROLL RUN DATES REPORT ;6/11/93 15:55
+1 ;;3.0;Occurrence Screen;;09/14/1993
ASK WRITE !!,"Include retired national screens"
+1 SET %=2
DO YN^DICN
if %=-1
GOTO EXIT
SET QAOSINAC=$SELECT(%=1:1,1:0)
IF '%
Begin DoDot:1
+2 WRITE !!?5,"Enter Y(es) to include the stats of retired national screens."
+3 WRITE !?5,"Enter N(o) to display only the current national screens."
+4 QUIT
End DoDot:1
GOTO ASK
+5 DO ^QAQDATE
if QAQQUIT
GOTO EXIT
+6 KILL %ZIS,IOP
SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN="ENTSK^QAOSPAU0"
SET ZTDESC="Auto enroll run dates tally"
+9 SET ZTSAVE("QAOS*")=""
SET ZTSAVE("QAQ*")=""
DO ^%ZTLOAD
+10 QUIT
End DoDot:1
GOTO EXIT
ENTSK ;
+1 SET QAOSQUIT=0
SET PAGE=1
SET Y=DT
XECUTE ^DD("DD")
SET TODAY=$PIECE(Y,"@")
+2 KILL UNDL
SET $PIECE(UNDL,"-",80)="-"
FOR QA=2:1:15
SET QAOSTOT(QA)=0
+3 SET X=QAQNBEG
DO H^%DTC
SET START=%H
SET X=QAQNEND
DO H^%DTC
SET END=%H
+4 USE IO
DO HEAD
+5 FOR QAOSDATE=START:1:END
if QAOSQUIT
QUIT
Begin DoDot:1
+6 SET %H=QAOSDATE
DO YMD^%DTC
SET QAOSDT=X
+7 SET QAOSD0=$ORDER(^QA(741.99,"B",QAOSDT,0))
SET Y=QAOSDT
XECUTE ^DD("DD")
+8 WRITE !!,$PIECE(Y,"@")
+9 IF QAOSD0'>0
WRITE ?14,"*** AUTO ENROLL DID NOT RUN ON THIS DATE ***"
GOTO CHK
+10 SET LOC=^QA(741.99,QAOSD0,0)
SET TAB=12
+11 IF QAOSINAC
FOR PIECE=2,14,3:1:13,15
DO PRINT
+12 IF '$TEST
FOR PIECE=14,3,11,13,15
DO PRINT
CHK IF $Y>(IOSL-6)&(QAOSDATE'=END)
if $EXTRACT(IOST)="C"
DO PAUSE
if QAOSQUIT
QUIT
DO HEAD
+1 QUIT
End DoDot:1
+2 if QAOSQUIT
GOTO EXIT
+3 WRITE !!,UNDL,!,"TOTALS:"
SET TAB=11
+4 IF QAOSINAC
FOR QA=2,14,3:1:13,15
WRITE ?TAB,$JUSTIFY(QAOSTOT(QA),4)
SET TAB=TAB+5
+5 IF '$TEST
FOR QA=14,3,11,13,15
WRITE ?TAB,$JUSTIFY(QAOSTOT(QA),4)
SET TAB=TAB+5
EXIT ;
+1 WRITE !
DO ^%ZISC
+2 KILL %H,%ZIS,END,LOC,PAGE,PIECE,POP,QA,QAOSD0,QAOSDATE,QAOSDT,QAOSINAC
+3 KILL QAOSQUIT,QAOSTOT,START,TAB,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,ZTSAVE,%DT,%T
+4 KILL D,I,Y,Z
+5 DO K^QAQDATE
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
PRINT ;
+1 SET QA=$PIECE(LOC,"^",PIECE)
SET QA=$SELECT(QA]"":QA,1:"???")
+2 WRITE ?TAB,$JUSTIFY(QA,3)
SET TAB=TAB+5
SET QAOSTOT(PIECE)=QAOSTOT(PIECE)+QA
+3 QUIT
HEAD ;
+1 if (PAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?29,"ENROLLMENT DATES TALLY",?68,TODAY
+3 WRITE !?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE
SET PAGE=PAGE+1
+4 IF QAOSINAC
WRITE !!,"RUN 101.1 103 104.2 105.2 106.2 108 199",!,"DATE 101 102 104.1 105.1 106.1 107 109"
+5 IF '$TEST
WRITE !!,"RUN 102 109",!,"DATE 101.1 107 199"
+6 WRITE !,UNDL
QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
+2 QUIT
