QAMAUTO0 ;HISC/DAD-AUTO ENROLL MAIN DRIVER ROUTINE ;6/18/93 15:52
;;1.0;Clinical Monitoring System;;09/13/1993
I $D(QAMTODAY)[0 S %DT="",X="T-1" D ^%DT S QAMTODAY=Y
K ^UTILITY($J,"QAM"),^("QAM CONDITION"),^("QAM FALL OUT"),^("QAM SAMPLE")
D EN4^QAMAUTO1 ; *** AUTO RUN DATES FILE, DATE
F QAMD0=0:0 S QAMD0=$O(^QA(743,QAMD0)) Q:QAMD0'>0 D GETMON
D EN2^QAMPRUN0 ; *** REPORT OF AUTO ENROLL MONITORS RUN
EXIT D ^QAMAUTO8 ; *** CLEAN-UP
S:$D(ZTQUEUED) ZTREQ="@"
Q
GETMON S QAMZERO=$S($D(^QA(743,QAMD0,0))#2:^(0),1:"") Q:$P(QAMZERO,"^",5)'>0
I $D(^UTILITY($J,"QAM MONITOR")) Q:$D(^UTILITY($J,"QAM MONITOR",$P(QAMZERO,"^"),QAMD0))[0
I $D(^UTILITY($J,"QAM SERVICE")) S QA=+$P(QAMZERO,"^",3),QAM=$S($D(^DIC(49,QA,0))#2:$P(^(0),"^"),1:0) Q:$D(^UTILITY($J,"QAM MONITOR",QAM,QA))[0
S QAMONE=$S($D(^QA(743,QAMD0,1))#2:^(1),1:"") Q:$P(QAMONE,"^",5)'>0
Q:$P(QAMONE,"^",6)>QAMTODAY Q:QAMTODAY>$P(QAMONE,"^",7)&$P(QAMONE,"^",7)
I $P(QAMZERO,"^",4)'>0 D ^QAMAUTO6,^QAMAUTO2 Q ; *** MANUAL ENROLL MONITOR
S QAMRELAT=$S($D(^QA(743,QAMD0,"REL"))#2:^("REL"),1:"") Q:QAMRELAT=""
S QAMSAMPL=$S($D(^QA(743,QAMD0,"SMP"))#2:^("SMP"),1:0)
Q:$D(^QA(743,QAMD0,"COND",0))[0 Q:$P(^(0),"^",4)'>0
F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"COND",QAMD1)) Q:QAMD1'>0 S @("C"_QAMD1)=1
S ^UTILITY($J,"QAM",QAMD0,"LST")=$P(QAMONE,"^",8)
S ^UTILITY($J,"QAM",QAMD0,"WSR")=$P(QAMONE,"^",9)_"^"_$S($D(^QA(743,QAMD0,"WSR"))#2:^("WSR"),1:"")
S ^UTILITY($J,"QAM",QAMD0,"SFR")=$S($D(^QA(743,QAMD0,"SFR"))#2:"1^"_^("SFR"),1:0)
Q:$D(^QA(743.6,QAMARUN,1,"B",QAMD0)) ;*** MONITOR ALREADY RAN THIS DATE
D EN5^QAMAUTO1 ; *** AUTO RUN DATES FILE, MONITOR
K QAMCOND,QAMCCOND,^UTILITY($J,"QAM CONDITION"),^UTILITY($J,"QAM FALL OUT",QAMD0),^UTILITY($J,"QAMSAMPLE",QAMD0)
; *** CONDITIONS
F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"COND",QAMD1)) Q:QAMD1'>0 D XCOND
; *** RELATIONSHIP
S (QAMFALL,QAMDENOM)=0,QAMCND=+$P(QAMONE,"^",15),DUPLICAT=$P(QAMONE,"^",14),^UTILITY($J,"QAM SAMPLE",QAMD0)=QAMDENOM,^UTILITY($J,"QAM FALL OUT",QAMD0)=QAMFALL
D EN^QAMTIME0
F QAMC0=0:0 S QAMC0=$O(^UTILITY($J,"QAM CONDITION",QAMC0)) Q:QAMC0'>0 F QAMDFN=0:0 S QAMDFN=$O(^UTILITY($J,"QAM CONDITION",QAMC0,QAMDFN)) Q:QAMDFN'>0 D REL0
S ^UTILITY($J,"QAM SAMPLE",QAMD0)=QAMDENOM,^UTILITY($J,"QAM FALL OUT",QAMD0)=QAMFALL K ^UTILITY($J,"QAM CONDITION")
D ^QAMAUTO2 ; *** UPDATE FALL OUT & HISTORY FILES, BULLETIN, REPORTS
Q
REL0 F QAMDATE=0:0 S QAMDATE=$O(^UTILITY($J,"QAM CONDITION",QAMC0,QAMDFN,QAMDATE)) Q:QAMDATE'>0 D REL1
Q
REL1 K QAMCARAY F QAMC1=0:0 S QAMC1=$O(^QA(743,QAMD0,"COND",QAMC1)) Q:QAMC1'>0 S QA=$D(^UTILITY($J,"QAM CONDITION",QAMC1,QAMDFN)),QAMCARAY("C"_QAMC1)=QA_"^"_(QA#2)
F QAMEVENT=0:0 S QAMEVENT=$O(^UTILITY($J,"QAM CONDITION",QAMCND,QAMDFN,QAMEVENT)) Q:QAMEVENT'>0 D REL2
I $D(^UTILITY($J,"QAM SAMPLE",QAMD0,QAMDFN,QAMDATE))[0 S QA="" F QA(0)=0:0 S QA=$O(QAMCARAY(QA)) Q:QA="" S @QA=+$P(QAMCARAY(QA),"^",2)
I I QAMSAMPL]"",@QAMSAMPL S ^UTILITY($J,"QAM SAMPLE",QAMD0,QAMDFN,QAMDATE)="",QAMDENOM=QAMDENOM+1
Q
REL2 I $D(^UTILITY($J,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT))[0 S QA="" F QA(0)=0:0 S QA=$O(QAMCARAY(QA)) Q:QA="" S @QA=+$P(QAMCARAY(QA),"^")
I I @QAMRELAT D ^QAMAUTO7
Q
XCOND S QAMCOND=$S($D(^QA(743,QAMD0,"COND",QAMD1,0))#2:^(0),1:"")
G:QAMCOND="" 2
S QAMCCODE=$S($D(^QA(743.3,+QAMCOND,"COND"))#2:^("COND"),1:"")
G:QAMCCODE="" 2
; *** S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN,QAMDATE)=""
S X=$P(QAMCCODE,"^",$L(QAMCCODE,"^")) X ^%ZOSF("TEST") I X QAMCCODE
2 K @("C"_QAMD1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMAUTO0 3534 printed Oct 16, 2024@17:42:35 Page 2
QAMAUTO0 ;HISC/DAD-AUTO ENROLL MAIN DRIVER ROUTINE ;6/18/93 15:52
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 IF $DATA(QAMTODAY)[0
SET %DT=""
SET X="T-1"
DO ^%DT
SET QAMTODAY=Y
+3 KILL ^UTILITY($JOB,"QAM"),^("QAM CONDITION"),^("QAM FALL OUT"),^("QAM SAMPLE")
+4 ; *** AUTO RUN DATES FILE, DATE
DO EN4^QAMAUTO1
+5 FOR QAMD0=0:0
SET QAMD0=$ORDER(^QA(743,QAMD0))
if QAMD0'>0
QUIT
DO GETMON
+6 ; *** REPORT OF AUTO ENROLL MONITORS RUN
DO EN2^QAMPRUN0
EXIT ; *** CLEAN-UP
DO ^QAMAUTO8
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
GETMON SET QAMZERO=$SELECT($DATA(^QA(743,QAMD0,0))#2:^(0),1:"")
if $PIECE(QAMZERO,"^",5)'>0
QUIT
+1 IF $DATA(^UTILITY($JOB,"QAM MONITOR"))
if $DATA(^UTILITY($JOB,"QAM MONITOR",$PIECE(QAMZERO,"^"),QAMD0))[0
QUIT
+2 IF $DATA(^UTILITY($JOB,"QAM SERVICE"))
SET QA=+$PIECE(QAMZERO,"^",3)
SET QAM=$SELECT($DATA(^DIC(49,QA,0))#2:$PIECE(^(0),"^"),1:0)
if $DATA(^UTILITY($JOB,"QAM MONITOR",QAM,QA))[0
QUIT
+3 SET QAMONE=$SELECT($DATA(^QA(743,QAMD0,1))#2:^(1),1:"")
if $PIECE(QAMONE,"^",5)'>0
QUIT
+4 if $PIECE(QAMONE,"^",6)>QAMTODAY
QUIT
if QAMTODAY>$PIECE(QAMONE,"^",7)&$PIECE(QAMONE,"^",7)
QUIT
+5 ; *** MANUAL ENROLL MONITOR
IF $PIECE(QAMZERO,"^",4)'>0
DO ^QAMAUTO6
DO ^QAMAUTO2
QUIT
+6 SET QAMRELAT=$SELECT($DATA(^QA(743,QAMD0,"REL"))#2:^("REL"),1:"")
if QAMRELAT=""
QUIT
+7 SET QAMSAMPL=$SELECT($DATA(^QA(743,QAMD0,"SMP"))#2:^("SMP"),1:0)
+8 if $DATA(^QA(743,QAMD0,"COND",0))[0
QUIT
if $PIECE(^(0),"^",4)'>0
QUIT
+9 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743,QAMD0,"COND",QAMD1))
if QAMD1'>0
QUIT
SET @("C"_QAMD1)=1
+10 SET ^UTILITY($JOB,"QAM",QAMD0,"LST")=$PIECE(QAMONE,"^",8)
+11 SET ^UTILITY($JOB,"QAM",QAMD0,"WSR")=$PIECE(QAMONE,"^",9)_"^"_$SELECT($DATA(^QA(743,QAMD0,"WSR"))#2:^("WSR"),1:"")
+12 SET ^UTILITY($JOB,"QAM",QAMD0,"SFR")=$SELECT($DATA(^QA(743,QAMD0,"SFR"))#2:"1^"_^("SFR"),1:0)
+13 ;*** MONITOR ALREADY RAN THIS DATE
if $DATA(^QA(743.6,QAMARUN,1,"B",QAMD0))
QUIT
+14 ; *** AUTO RUN DATES FILE, MONITOR
DO EN5^QAMAUTO1
+15 KILL QAMCOND,QAMCCOND,^UTILITY($JOB,"QAM CONDITION"),^UTILITY($JOB,"QAM FALL OUT",QAMD0),^UTILITY($JOB,"QAMSAMPLE",QAMD0)
+16 ; *** CONDITIONS
+17 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743,QAMD0,"COND",QAMD1))
if QAMD1'>0
QUIT
DO XCOND
+18 ; *** RELATIONSHIP
+19 SET (QAMFALL,QAMDENOM)=0
SET QAMCND=+$PIECE(QAMONE,"^",15)
SET DUPLICAT=$PIECE(QAMONE,"^",14)
SET ^UTILITY($JOB,"QAM SAMPLE",QAMD0)=QAMDENOM
SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0)=QAMFALL
+20 DO EN^QAMTIME0
+21 FOR QAMC0=0:0
SET QAMC0=$ORDER(^UTILITY($JOB,"QAM CONDITION",QAMC0))
if QAMC0'>0
QUIT
FOR QAMDFN=0:0
SET QAMDFN=$ORDER(^UTILITY($JOB,"QAM CONDITION",QAMC0,QAMDFN))
if QAMDFN'>0
QUIT
DO REL0
+22 SET ^UTILITY($JOB,"QAM SAMPLE",QAMD0)=QAMDENOM
SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0)=QAMFALL
KILL ^UTILITY($JOB,"QAM CONDITION")
+23 ; *** UPDATE FALL OUT & HISTORY FILES, BULLETIN, REPORTS
DO ^QAMAUTO2
+24 QUIT
REL0 FOR QAMDATE=0:0
SET QAMDATE=$ORDER(^UTILITY($JOB,"QAM CONDITION",QAMC0,QAMDFN,QAMDATE))
if QAMDATE'>0
QUIT
DO REL1
+1 QUIT
REL1 KILL QAMCARAY
FOR QAMC1=0:0
SET QAMC1=$ORDER(^QA(743,QAMD0,"COND",QAMC1))
if QAMC1'>0
QUIT
SET QA=$DATA(^UTILITY($JOB,"QAM CONDITION",QAMC1,QAMDFN))
SET QAMCARAY("C"_QAMC1)=QA_"^"_(QA#2)
+1 FOR QAMEVENT=0:0
SET QAMEVENT=$ORDER(^UTILITY($JOB,"QAM CONDITION",QAMCND,QAMDFN,QAMEVENT))
if QAMEVENT'>0
QUIT
DO REL2
+2 IF $DATA(^UTILITY($JOB,"QAM SAMPLE",QAMD0,QAMDFN,QAMDATE))[0
SET QA=""
FOR QA(0)=0:0
SET QA=$ORDER(QAMCARAY(QA))
if QA=""
QUIT
SET @QA=+$PIECE(QAMCARAY(QA),"^",2)
+3 IF $TEST
IF QAMSAMPL]""
IF @QAMSAMPL
SET ^UTILITY($JOB,"QAM SAMPLE",QAMD0,QAMDFN,QAMDATE)=""
SET QAMDENOM=QAMDENOM+1
+4 QUIT
REL2 IF $DATA(^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAMDFN,QAMEVENT))[0
SET QA=""
FOR QA(0)=0:0
SET QA=$ORDER(QAMCARAY(QA))
if QA=""
QUIT
SET @QA=+$PIECE(QAMCARAY(QA),"^")
+1 IF $TEST
IF @QAMRELAT
DO ^QAMAUTO7
+2 QUIT
XCOND SET QAMCOND=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,0))#2:^(0),1:"")
+1 if QAMCOND=""
GOTO 2
+2 SET QAMCCODE=$SELECT($DATA(^QA(743.3,+QAMCOND,"COND"))#2:^("COND"),1:"")
+3 if QAMCCODE=""
GOTO 2
+4 ; *** S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN,QAMDATE)=""
+5 SET X=$PIECE(QAMCCODE,"^",$LENGTH(QAMCCODE,"^"))
XECUTE ^%ZOSF("TEST")
IF $TEST
XECUTE QAMCCODE
2 KILL @("C"_QAMD1)
+1 QUIT
