- QAMAUTO4 ;HISC/DAD-AUTO ENROLL RERUN FOR A DATE RANGE ;5/26/93 09:25
- ;;1.0;Clinical Monitoring System;;09/13/1993
- EN S PROBLEM=0,QAMPARAM=$S($D(^QA(740,1,"QAM"))#2:^("QAM"),1:""),QA=$P($P(QAMPARAM,"^",2),";"),PROBLEM=$S(QA="":1,'$D(^%ZIS(1,"B",QA)):1,1:0) I 'PROBLEM F QA=3:1:5 S PROBLEM=$S($P(QAMPARAM,"^",QA)="":1,1:0) Q:PROBLEM
- I PROBLEM W !!!?3,"***********************************************************************",*7,!?3,"* Auto enroll has found important site parameters to be missing *"
- I W !?3,"* Use the 'Site Parameters Edit' option to enter the necessary data *",!?3,"***********************************************************************",*7 G EXIT
- OK ;
- K ^UTILITY($J,"QAM MONITOR"),^("QAM SERVICE"),^("QAMAUTO45")
- MON W !!,"Want to run auto enroll for specific monitors" S %=2 D YN^DICN G EXIT:%=-1,SRV:%=2 I '% W !!?5,"Please answer Y(es) or N(o)" G MON
- S QAQDIC="^QA(743,",QAQDIC(0)="AEMNQZ",QAQDIC("A")="Select MONITOR: ",QAQDIC("S")="I $P(^(0),""^"",5),$P($G(^(1)),""^"",5)",QAQUTIL="QAM MONITOR" D EN1^QAQSELCT I QAQQUIT W !!,"*** No monitors selected ***",*7 G EXIT
- SRV W !!,"Want to run auto enroll for specific services" S %=2 D YN^DICN G EXIT:%=-1,DATE:%=2 I '% W !!?5,"Please answer Y(es) or N(o)" G SRV
- S QAQDIC="^DIC(49,",QAQDIC(0)="AEMNQZ",QAQDIC("A")="Select SERVICE: ",QAQUTIL="QAM SERVICE" D EN1^QAQSELCT I QAQQUIT W !!,"*** No services selected ***",*7 G EXIT
- DATE ; *** CALLED HERE BY QAOAUTO - OS/3 'RERUN' AUTO ENROLL
- W !!,"Enter the date range you want auto enroll to scan" D ^QAQDATE G:QAQQUIT EXIT S %DT="",X="T" D ^%DT S QAMDT=Y
- I (QAQNBEG'<QAMDT)!(QAQNEND'<QAMDT) W !!?5,"*** Start and end dates must be T-1 or earlier ***",!,*7 G DATE
- ZTDTH S %DT="AEPRSX",%DT(0)="NOW",%DT("A")="Queue auto enroll to run at: " D ^%DT K %DT G:Y'>0 EXIT
- S QAMQTIME(0)=$P(Y,".",2),ZTDTH=Y\1,QAMQTIME(0)=QAMQTIME(0)_$E("000000",1,6-$L(QAMQTIME(0))),X=$P(QAMPARAM,"^",5),QAMQBEG=$P(X,"-")_"00",QAMQEND=$P(X,"-",2)_"00"
- I (QAMQTIME(0)<QAMQBEG)!(QAMQTIME(0)>QAMQEND) W " ??",*7,!!?5,"Queueing time must be between ",$E(QAMQBEG,1,4)," and ",$E(QAMQEND,1,4),! G ZTDTH
- S (ZTDTH,QAMQTIME)=ZTDTH_"."_QAMQTIME(0),QAMAXDAY=$P(QAMPARAM,"^",3)-1,QAMHANG=$P(QAMPARAM,"^",4),QAQNBEG(0)=QAQNBEG,QAQNEND(0)=QAQNEND W !!,"Queueing auto enroll, please wait"
- F QA=0:0 S X1=QAQNBEG,X2=QAMAXDAY D C^%DTC S QAQNEND=$S(X>QAQNEND(0):QAQNEND(0),1:X) D QUEUE Q:QAQNEND(0)=QAQNEND S X1=QAQNEND,X2=1 D C^%DTC S QAQNBEG=X
- RPT W !!,"Want a report of the dates when auto enroll will run" S %=1 D YN^DICN I '% W !!?5,"Please answer Y(es) or N(o)" G RPT
- D:%=1 ^QAMAUTO5 G EXIT
- QUEUE ;
- S ZTRTN="ENTSK^QAMAUTO4",(ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"),ZTSAVE("^UTILITY($J,"))="",ZTDESC="Rerun auto enroll for a given date range",ZTIO="" K ZTSK D ^%ZTLOAD W "."
- S ^UTILITY($J,"QAMAUTO45",QAQNBEG)=QAQNBEG_"^"_QAQNEND_"^"_QAMQTIME_"^"_$S($D(ZTSK)#2:ZTSK,1:"")
- S X=QAMQTIME D H^%DTC S QA1=%H,QA2=%T+(60*QAMHANG),%H=(QA1+(QA2\86400))_","_(QA2#86400) D YMD^%DTC S %=$P(%,".",2),%=%_$E("000000",1,6-$L(%)),(ZTDTH,QAMQTIME)=X_"."_%
- I (%<QAMQBEG)!(%>QAMQEND) S (ZTDTH,QAMQTIME)=QAMQTIME\1_"."_QAMQTIME(0)
- Q
- ENTSK ;
- F QAMRANGE=QAQNBEG:0 S QAMTODAY=QAMRANGE D ^QAMAUTO0 S X1=QAMRANGE,X2=1 D C^%DTC S QAMRANGE=X Q:QAMRANGE>QAQNEND
- EXIT ;
- K %DT,QAMRANGE,X,X1,X2,%H,%T,D,I,Y,ZTSK,ZTSAVE,ZTDESC,ZTDTH,ZTRTN,ZTIO,QAMDT,QAMPARAM,PROBLEM,QAQQUIT,QA1,QA2,QAMAXDAY,QAMHANG,QAMQBEG,QAMQEND,QAMQTIME
- K ^UTILITY($J,"QAM MONITOR"),^("QAM SERVICE"),^("QAMAUTO45")
- D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAUTO4 3532 printed Mar 13, 2025@20:46:27 Page 2
- QAMAUTO4 ;HISC/DAD-AUTO ENROLL RERUN FOR A DATE RANGE ;5/26/93 09:25
- +1 ;;1.0;Clinical Monitoring System;;09/13/1993
- EN SET PROBLEM=0
- SET QAMPARAM=$SELECT($DATA(^QA(740,1,"QAM"))#2:^("QAM"),1:"")
- SET QA=$PIECE($PIECE(QAMPARAM,"^",2),";")
- SET PROBLEM=$SELECT(QA="":1,'$DATA(^%ZIS(1,"B",QA)):1,1:0)
- IF 'PROBLEM
- FOR QA=3:1:5
- SET PROBLEM=$SELECT($PIECE(QAMPARAM,"^",QA)="":1,1:0)
- if PROBLEM
- QUIT
- +1 IF PROBLEM
- WRITE !!!?3,"***********************************************************************",*7,!?3,"* Auto enroll has found important site parameters to be missing *"
- +2 IF $TEST
- WRITE !?3,"* Use the 'Site Parameters Edit' option to enter the necessary data *",!?3,"***********************************************************************",*7
- GOTO EXIT
- OK ;
- +1 KILL ^UTILITY($JOB,"QAM MONITOR"),^("QAM SERVICE"),^("QAMAUTO45")
- MON WRITE !!,"Want to run auto enroll for specific monitors"
- SET %=2
- DO YN^DICN
- if %=-1
- GOTO EXIT
- if %=2
- GOTO SRV
- IF '%
- WRITE !!?5,"Please answer Y(es) or N(o)"
- GOTO MON
- +1 SET QAQDIC="^QA(743,"
- SET QAQDIC(0)="AEMNQZ"
- SET QAQDIC("A")="Select MONITOR: "
- SET QAQDIC("S")="I $P(^(0),""^"",5),$P($G(^(1)),""^"",5)"
- SET QAQUTIL="QAM MONITOR"
- DO EN1^QAQSELCT
- IF QAQQUIT
- WRITE !!,"*** No monitors selected ***",*7
- GOTO EXIT
- SRV WRITE !!,"Want to run auto enroll for specific services"
- SET %=2
- DO YN^DICN
- if %=-1
- GOTO EXIT
- if %=2
- GOTO DATE
- IF '%
- WRITE !!?5,"Please answer Y(es) or N(o)"
- GOTO SRV
- +1 SET QAQDIC="^DIC(49,"
- SET QAQDIC(0)="AEMNQZ"
- SET QAQDIC("A")="Select SERVICE: "
- SET QAQUTIL="QAM SERVICE"
- DO EN1^QAQSELCT
- IF QAQQUIT
- WRITE !!,"*** No services selected ***",*7
- GOTO EXIT
- DATE ; *** CALLED HERE BY QAOAUTO - OS/3 'RERUN' AUTO ENROLL
- +1 WRITE !!,"Enter the date range you want auto enroll to scan"
- DO ^QAQDATE
- if QAQQUIT
- GOTO EXIT
- SET %DT=""
- SET X="T"
- DO ^%DT
- SET QAMDT=Y
- +2 IF (QAQNBEG'<QAMDT)!(QAQNEND'<QAMDT)
- WRITE !!?5,"*** Start and end dates must be T-1 or earlier ***",!,*7
- GOTO DATE
- ZTDTH SET %DT="AEPRSX"
- SET %DT(0)="NOW"
- SET %DT("A")="Queue auto enroll to run at: "
- DO ^%DT
- KILL %DT
- if Y'>0
- GOTO EXIT
- +1 SET QAMQTIME(0)=$PIECE(Y,".",2)
- SET ZTDTH=Y\1
- SET QAMQTIME(0)=QAMQTIME(0)_$EXTRACT("000000",1,6-$LENGTH(QAMQTIME(0)))
- SET X=$PIECE(QAMPARAM,"^",5)
- SET QAMQBEG=$PIECE(X,"-")_"00"
- SET QAMQEND=$PIECE(X,"-",2)_"00"
- +2 IF (QAMQTIME(0)<QAMQBEG)!(QAMQTIME(0)>QAMQEND)
- WRITE " ??",*7,!!?5,"Queueing time must be between ",$EXTRACT(QAMQBEG,1,4)," and ",$EXTRACT(QAMQEND,1,4),!
- GOTO ZTDTH
- +3 SET (ZTDTH,QAMQTIME)=ZTDTH_"."_QAMQTIME(0)
- SET QAMAXDAY=$PIECE(QAMPARAM,"^",3)-1
- SET QAMHANG=$PIECE(QAMPARAM,"^",4)
- SET QAQNBEG(0)=QAQNBEG
- SET QAQNEND(0)=QAQNEND
- WRITE !!,"Queueing auto enroll, please wait"
- +4 FOR QA=0:0
- SET X1=QAQNBEG
- SET X2=QAMAXDAY
- DO C^%DTC
- SET QAQNEND=$SELECT(X>QAQNEND(0):QAQNEND(0),1:X)
- DO QUEUE
- if QAQNEND(0)=QAQNEND
- QUIT
- SET X1=QAQNEND
- SET X2=1
- DO C^%DTC
- SET QAQNBEG=X
- RPT WRITE !!,"Want a report of the dates when auto enroll will run"
- SET %=1
- DO YN^DICN
- IF '%
- WRITE !!?5,"Please answer Y(es) or N(o)"
- GOTO RPT
- +1 if %=1
- DO ^QAMAUTO5
- GOTO EXIT
- QUEUE ;
- +1 SET ZTRTN="ENTSK^QAMAUTO4"
- SET (ZTSAVE("QAQNBEG"),ZTSAVE("QAQNEND"),ZTSAVE("^UTILITY($J,"))=""
- SET ZTDESC="Rerun auto enroll for a given date range"
- SET ZTIO=""
- KILL ZTSK
- DO ^%ZTLOAD
- WRITE "."
- +2 SET ^UTILITY($JOB,"QAMAUTO45",QAQNBEG)=QAQNBEG_"^"_QAQNEND_"^"_QAMQTIME_"^"_$SELECT($DATA(ZTSK)#2:ZTSK,1:"")
- +3 SET X=QAMQTIME
- DO H^%DTC
- SET QA1=%H
- SET QA2=%T+(60*QAMHANG)
- SET %H=(QA1+(QA2\86400))_","_(QA2#86400)
- DO YMD^%DTC
- SET %=$PIECE(%,".",2)
- SET %=%_$EXTRACT("000000",1,6-$LENGTH(%))
- SET (ZTDTH,QAMQTIME)=X_"."_%
- +4 IF (%<QAMQBEG)!(%>QAMQEND)
- SET (ZTDTH,QAMQTIME)=QAMQTIME\1_"."_QAMQTIME(0)
- +5 QUIT
- ENTSK ;
- +1 FOR QAMRANGE=QAQNBEG:0
- SET QAMTODAY=QAMRANGE
- DO ^QAMAUTO0
- SET X1=QAMRANGE
- SET X2=1
- DO C^%DTC
- SET QAMRANGE=X
- if QAMRANGE>QAQNEND
- QUIT
- EXIT ;
- +1 KILL %DT,QAMRANGE,X,X1,X2,%H,%T,D,I,Y,ZTSK,ZTSAVE,ZTDESC,ZTDTH,ZTRTN,ZTIO,QAMDT,QAMPARAM,PROBLEM,QAQQUIT,QA1,QA2,QAMAXDAY,QAMHANG,QAMQBEG,QAMQEND,QAMQTIME
- +2 KILL ^UTILITY($JOB,"QAM MONITOR"),^("QAM SERVICE"),^("QAMAUTO45")
- +3 DO K^QAQDATE
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 QUIT
