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 Nov 22, 2024@16:52 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
