QAMAUTO5 ;HISC/DAD-AUTO ENROLL MANUALLY QUEUE RUN ;9/14/92 11:26
;;1.0;Clinical Monitoring System;;09/13/1993
K %ZIS,IOP S %ZIS="MQ" W ! D ^%ZIS G:POP EXIT I $D(IO("Q")) K IO("Q") S ZTDESC="Manually queued auto enroll run dates report",ZTRTN="ENTSK^QAMAUTO5",ZTSAVE("QAM*")="",ZTSAVE("QAQ*")="",ZTSAVE("^UTILITY($J,")="" D ^%ZTLOAD G EXIT
ENTSK ;
U IO S QAMQUIT=0,PAGE=1,X="T",%DT="" D ^%DT X ^DD("DD") S TODAY=Y K UNDL S $P(UNDL,"-",80)="-" D HEAD
I $O(^UTILITY($J,"QAMAUTO45",0))'>0 W !!,"NO DATA FOUND FOR THIS REPORT" G EXIT
F QAMSTART=0:0 S QAMSTART=$O(^UTILITY($J,"QAMAUTO45",QAMSTART)) Q:QAMSTART'>0!QAMQUIT D LOOP1
EXIT ;
D ^%ZISC
K DIR,PAGE,TODAY,UNDL,QA,QAMSTART,QAMQUIT,POP,^UTILITY($J,"QAMAUTO45")
S:$D(ZTQUEUED) ZTREQ="@"
Q
LOOP1 ;
S QA=^UTILITY($J,"QAMAUTO45",QAMSTART),Y=+QA X ^DD("DD") S QA(1)=Y,Y=$P(QA,"^",2) X ^DD("DD") S QA(2)=Y,Y=$P(QA,"^",3) X ^DD("DD") S QA(3)=Y,QA(4)=$P(QA,"^",4) S:QA(4)]"" QA(4)=$J(QA(4),12,0)
W !!,QA(1),?20,QA(2),?40,QA(3),?60,QA(4) I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAMQUIT D:$O(^UTILITY($J,"QAMAUTO45",QAMSTART)) HEAD
Q
PAUSE ;
K DIR S DIR(0)="E" D ^DIR K DIR S QAMQUIT=$S(Y'>0:1,1:0)
Q
HEAD ;
W:(PAGE>1)!($E(IOST)="C") @IOF
W !!?21,"MANUALLY QUEUED AUTO ENROLL RUN DATES",?68,TODAY,!?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1
W !!,"START DATE",?20,"END DATE",?40,"QUEUED TO RUN",?61,"TASK NUMBER",!,UNDL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAUTO5 1408 printed Apr 09, 2024@20:47:07 Page 2
QAMAUTO5 ;HISC/DAD-AUTO ENROLL MANUALLY QUEUE RUN ;9/14/92 11:26
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 KILL %ZIS,IOP
SET %ZIS="MQ"
WRITE !
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="Manually queued auto enroll run dates report"
SET ZTRTN="ENTSK^QAMAUTO5"
SET ZTSAVE("QAM*")=""
SET ZTSAVE("QAQ*")=""
SET ZTSAVE("^UTILITY($J,")=""
DO ^%ZTLOAD
GOTO EXIT
ENTSK ;
+1 USE IO
SET QAMQUIT=0
SET PAGE=1
SET X="T"
SET %DT=""
DO ^%DT
XECUTE ^DD("DD")
SET TODAY=Y
KILL UNDL
SET $PIECE(UNDL,"-",80)="-"
DO HEAD
+2 IF $ORDER(^UTILITY($JOB,"QAMAUTO45",0))'>0
WRITE !!,"NO DATA FOUND FOR THIS REPORT"
GOTO EXIT
+3 FOR QAMSTART=0:0
SET QAMSTART=$ORDER(^UTILITY($JOB,"QAMAUTO45",QAMSTART))
if QAMSTART'>0!QAMQUIT
QUIT
DO LOOP1
EXIT ;
+1 DO ^%ZISC
+2 KILL DIR,PAGE,TODAY,UNDL,QA,QAMSTART,QAMQUIT,POP,^UTILITY($JOB,"QAMAUTO45")
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
LOOP1 ;
+1 SET QA=^UTILITY($JOB,"QAMAUTO45",QAMSTART)
SET Y=+QA
XECUTE ^DD("DD")
SET QA(1)=Y
SET Y=$PIECE(QA,"^",2)
XECUTE ^DD("DD")
SET QA(2)=Y
SET Y=$PIECE(QA,"^",3)
XECUTE ^DD("DD")
SET QA(3)=Y
SET QA(4)=$PIECE(QA,"^",4)
if QA(4)]""
SET QA(4)=$JUSTIFY(QA(4),12,0)
+2 WRITE !!,QA(1),?20,QA(2),?40,QA(3),?60,QA(4)
IF $Y>(IOSL-6)
if $EXTRACT(IOST)="C"
DO PAUSE
if QAMQUIT
QUIT
if $ORDER(^UTILITY($JOB,"QAMAUTO45",QAMSTART))
DO HEAD
+3 QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET QAMQUIT=$SELECT(Y'>0:1,1:0)
+2 QUIT
HEAD ;
+1 if (PAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?21,"MANUALLY QUEUED AUTO ENROLL RUN DATES",?68,TODAY,!?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE
SET PAGE=PAGE+1
+3 WRITE !!,"START DATE",?20,"END DATE",?40,"QUEUED TO RUN",?61,"TASK NUMBER",!,UNDL
+4 QUIT
