- 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 Mar 13, 2025@21:26:34 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
