- 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 Mar 13, 2025@20:47:21 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
