QAMPRUN0 ;HISC/DAD-AUTO ENROLL MONITOR RUN REPORT ;5/5/93 14:43
;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** MENU ENTRY POINT
D ^QAQDATE G:QAQQUIT EXIT
K %ZIS,IOP S %ZIS="MQ" D ^%ZIS G:POP EXIT I $D(IO("Q")) K IO("Q") S ZTDESC="Auto enroll monitor run report",ZTRTN="ENTSK^QAMPRUN0",ZTSAVE("QAM*")="",ZTSAVE("QAQ*")="" D ^%ZTLOAD G EXIT
ENTSK ;
K ^UTILITY($J,"QAMPRUN0") S X=QAQNBEG D H^%DTC S START=%H,X=QAQNEND D H^%DTC S END=%H
F QAMDATE=START:1:END S %H=QAMDATE D YMD^%DTC S QAMDT=X D SLOOP1
U IO S QAMQUIT=0,%DT="",X="T" D ^%DT X ^DD("DD") S TODAY=Y,PAGE=1 K UNDL S $P(UNDL,"-",80)="-"
D HEAD I '$D(^UTILITY($J,"QAMPRUN0")) W !!,"*** NO DATA FOUND FOR THIS REPORT ***" G EXIT
F QAMDT=0:0 S QAMDT=$O(^UTILITY($J,"QAMPRUN0",QAMDT)) Q:QAMDT'>0!QAMQUIT D PLOOP1
EXIT ;
W ! D ^%ZISC
K %DT,%H,%ZIS,DIR,END,IOP,PAGE,POP,QA,QAM,QAMDATE,QAMDT,QAMMON,QAMQUIT,QAMS0,QAMS1,START,TODAY,UNDL,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE D K^QAQDATE
S:$D(ZTQUEUED) ZTREQ="@"
Q
SLOOP1 ;
S QAMS0=$O(^QA(743.6,"B",QAMDT,0)),Y=QAMDT X ^DD("DD")
S ^UTILITY($J,"QAMPRUN0",QAMDT)=$S(QAMS0'>0:Y_"^*** AUTO ENROLL DID NOT RUN FOR THIS DATE ***",1:Y_"^") Q:QAMS0'>0
F QAMS1=0:0 S QAMS1=$O(^QA(743.6,QAMS0,1,QAMS1)) Q:QAMS1'>0 D SLOOP2
Q
SLOOP2 ;
S QA=^QA(743.6,QAMS0,1,QAMS1,0),QAM=$G(^QA(743,+QA,0)) Q:QAM=""
S Y=$P(QA,"^",2) X ^DD("DD") S ^UTILITY($J,"QAMPRUN0",QAMDT,$P(QAM,"^"))=$P(QAM,"^",2)_"^"_Y_"^"_$S($P(QAM,"^",4)'>0:" (m)",1:" (a)")
Q
PLOOP1 ;
S QA=^UTILITY($J,"QAMPRUN0",QAMDT) W !!,$P(QA,"^"),?15,$P(QA,"^",2)
I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAMQUIT D HEAD
Q:$P(QA,"^",2)]""
S QAMMON="" F QAMMON(0)=0:1 S QAMMON=$O(^UTILITY($J,"QAMPRUN0",QAMDT,QAMMON)) Q:QAMMON=""!QAMQUIT D PLOOP2
W:QAMMON(0)'>0 !?2,"*** NO MONITORS RUN ***"
Q
PLOOP2 ;
S QA=^UTILITY($J,"QAMPRUN0",QAMDT,QAMMON) W !?2,QAMMON,$P(QA,"^",3),?35,$P(QA,"^"),?68,$P(QA,"^",2) I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAMQUIT D HEAD
Q
HEAD ;
W:(PAGE>1)!($E(IOST)="C") @IOF
W !!?24,"AUTO/MANUAL ENROLL MONITORS RUN",?68,TODAY,!?80-$L(QAQ2HED)/2,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1
W !,"AUTO ENROLL RUN DATE",!?2,"MONITOR CODE (a/m=AUTO/MANUAL)",?35,"MONITOR TITLE",?68,"DATE RUN",!,UNDL
Q
PAUSE ;
K DIR S DIR(0)="E" D ^DIR S QAMQUIT=$S(Y'>0:1,1:0)
Q
EN2 ; *** AUTO ENROLL ENTRY POINT
D 2 S ZTIO=$P($G(^QA(740,1,"QAM")),"^",2) G:ZTIO="" 2 S Y=QAMTODAY X ^DD("DD") S QAQ2HED="FOR "_Y,ZTDESC="Auto enroll monitor run report",ZTRTN="ENTSK^QAMPRUN0",ZTDTH=$H
S (ZTSAVE("QAM*"),ZTSAVE("QAQ2HED"))="",(ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"))=QAMTODAY D ^%ZTLOAD
2 K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMPRUN0 2636 printed Dec 13, 2024@01:42:41 Page 2
QAMPRUN0 ;HISC/DAD-AUTO ENROLL MONITOR RUN REPORT ;5/5/93 14:43
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ; *** MENU ENTRY POINT
+1 DO ^QAQDATE
if QAQQUIT
GOTO EXIT
+2 KILL %ZIS,IOP
SET %ZIS="MQ"
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="Auto enroll monitor run report"
SET ZTRTN="ENTSK^QAMPRUN0"
SET ZTSAVE("QAM*")=""
SET ZTSAVE("QAQ*")=""
DO ^%ZTLOAD
GOTO EXIT
ENTSK ;
+1 KILL ^UTILITY($JOB,"QAMPRUN0")
SET X=QAQNBEG
DO H^%DTC
SET START=%H
SET X=QAQNEND
DO H^%DTC
SET END=%H
+2 FOR QAMDATE=START:1:END
SET %H=QAMDATE
DO YMD^%DTC
SET QAMDT=X
DO SLOOP1
+3 USE IO
SET QAMQUIT=0
SET %DT=""
SET X="T"
DO ^%DT
XECUTE ^DD("DD")
SET TODAY=Y
SET PAGE=1
KILL UNDL
SET $PIECE(UNDL,"-",80)="-"
+4 DO HEAD
IF '$DATA(^UTILITY($JOB,"QAMPRUN0"))
WRITE !!,"*** NO DATA FOUND FOR THIS REPORT ***"
GOTO EXIT
+5 FOR QAMDT=0:0
SET QAMDT=$ORDER(^UTILITY($JOB,"QAMPRUN0",QAMDT))
if QAMDT'>0!QAMQUIT
QUIT
DO PLOOP1
EXIT ;
+1 WRITE !
DO ^%ZISC
+2 KILL %DT,%H,%ZIS,DIR,END,IOP,PAGE,POP,QA,QAM,QAMDATE,QAMDT,QAMMON,QAMQUIT,QAMS0,QAMS1,START,TODAY,UNDL,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
DO K^QAQDATE
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
SLOOP1 ;
+1 SET QAMS0=$ORDER(^QA(743.6,"B",QAMDT,0))
SET Y=QAMDT
XECUTE ^DD("DD")
+2 SET ^UTILITY($JOB,"QAMPRUN0",QAMDT)=$SELECT(QAMS0'>0:Y_"^*** AUTO ENROLL DID NOT RUN FOR THIS DATE ***",1:Y_"^")
if QAMS0'>0
QUIT
+3 FOR QAMS1=0:0
SET QAMS1=$ORDER(^QA(743.6,QAMS0,1,QAMS1))
if QAMS1'>0
QUIT
DO SLOOP2
+4 QUIT
SLOOP2 ;
+1 SET QA=^QA(743.6,QAMS0,1,QAMS1,0)
SET QAM=$GET(^QA(743,+QA,0))
if QAM=""
QUIT
+2 SET Y=$PIECE(QA,"^",2)
XECUTE ^DD("DD")
SET ^UTILITY($JOB,"QAMPRUN0",QAMDT,$PIECE(QAM,"^"))=$PIECE(QAM,"^",2)_"^"_Y_"^"_$SELECT($PIECE(QAM,"^",4)'>0:" (m)",1:" (a)")
+3 QUIT
PLOOP1 ;
+1 SET QA=^UTILITY($JOB,"QAMPRUN0",QAMDT)
WRITE !!,$PIECE(QA,"^"),?15,$PIECE(QA,"^",2)
+2 IF $Y>(IOSL-6)
if $EXTRACT(IOST)="C"
DO PAUSE
if QAMQUIT
QUIT
DO HEAD
+3 if $PIECE(QA,"^",2)]""
QUIT
+4 SET QAMMON=""
FOR QAMMON(0)=0:1
SET QAMMON=$ORDER(^UTILITY($JOB,"QAMPRUN0",QAMDT,QAMMON))
if QAMMON=""!QAMQUIT
QUIT
DO PLOOP2
+5 if QAMMON(0)'>0
WRITE !?2,"*** NO MONITORS RUN ***"
+6 QUIT
PLOOP2 ;
+1 SET QA=^UTILITY($JOB,"QAMPRUN0",QAMDT,QAMMON)
WRITE !?2,QAMMON,$PIECE(QA,"^",3),?35,$PIECE(QA,"^"),?68,$PIECE(QA,"^",2)
IF $Y>(IOSL-6)
if $EXTRACT(IOST)="C"
DO PAUSE
if QAMQUIT
QUIT
DO HEAD
+2 QUIT
HEAD ;
+1 if (PAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?24,"AUTO/MANUAL ENROLL MONITORS RUN",?68,TODAY,!?80-$LENGTH(QAQ2HED)/2,QAQ2HED,?68,"PAGE: ",PAGE
SET PAGE=PAGE+1
+3 WRITE !,"AUTO ENROLL RUN DATE",!?2,"MONITOR CODE (a/m=AUTO/MANUAL)",?35,"MONITOR TITLE",?68,"DATE RUN",!,UNDL
+4 QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
SET QAMQUIT=$SELECT(Y'>0:1,1:0)
+2 QUIT
EN2 ; *** AUTO ENROLL ENTRY POINT
+1 DO 2
SET ZTIO=$PIECE($GET(^QA(740,1,"QAM")),"^",2)
if ZTIO=""
GOTO 2
SET Y=QAMTODAY
XECUTE ^DD("DD")
SET QAQ2HED="FOR "_Y
SET ZTDESC="Auto enroll monitor run report"
SET ZTRTN="ENTSK^QAMPRUN0"
SET ZTDTH=$HOROLOG
+2 SET (ZTSAVE("QAM*"),ZTSAVE("QAQ2HED"))=""
SET (ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"))=QAMTODAY
DO ^%ZTLOAD
2 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
+1 QUIT
