QAOAUTO ;HISC/DAD-AUTO ENROLL RERUN FOR A DATE RANGE ;6/23/93 09:35
;;3.0;Occurrence Screen;;09/14/1993
S QAMPARAM=$G(^QA(740,1,"QAM")),QAOPARAM=$G(^QA(740,1,"OS"))
F QA=3:1:5 I $S($P(QAMPARAM,"^",QA)="":1,1:0) D PROBLEM G EXIT
I $$CHKDEV($P($P(QAMPARAM,"^",2),";")) D PROBLEM G EXIT
I $P(QAOPARAM,"^",9)'>0,$$CHKDEV($P($P(QAOPARAM,"^",5),";")) D PROBLEM G EXIT
I $P(QAOPARAM,"^",9) S QAOSQUIT=0 D G:QAOSQUIT EXIT
. F QA=0:0 S QA=$O(^QA(740,1,"OS2",QA)) Q:QA'>0 D Q:QAOSQUIT
.. S X=$P($P(^QA(740,1,"OS2",QA,0),"^",2),";")
.. I $$CHKDEV(X) D PROBLEM S QAOSQUIT=1
.. Q
. Q
S QAQDIC="^QA(741.1,",QAQDIC(0)="AEMQZ",QAQUTIL="QAO"
S QAQDIC("A")="Select AUTO ENROLL SCREEN: ",QAQDIC("B")="ALL"
S QAQDIC("S")="S QAOS=^(0) I '$P(QAOS,""^"",4),$P(QAOS,""^"",5)"
K ^UTILITY($J,"QAO"),^UTILITY($J,"QAM MONITOR") D ^QAQSELCT
I $O(^UTILITY($J,"QAO",""))="" W *7,!!?5,"*** No screens selected !! ***",*7
G:QAQQUIT EXIT
S QAOSSCRN="" F S QAOSSCRN=$O(^UTILITY($J,"QAO",QAOSSCRN)) Q:QAOSSCRN="" F QAOSD0=0:0 S QAOSD0=$O(^UTILITY($J,"QAO",QAOSSCRN,QAOSD0)) Q:QAOSD0'>0 D
. S QAO=$G(^QA(741.1,QAOSD0,0))
. S QAMD0=+$P(QAO,"^",5),QA=$G(^QA(743,QAMD0,0))
. I QA="" W !!?5,"*** No monitor found for screen ",QAOSSCRN," !! ***" Q
. S ^UTILITY($J,"QAM MONITOR",$P(QA,"^"),QAMD0)=""
. Q
K ^UTILITY($J,"QAO") I $O(^UTILITY($J,"QAM MONITOR",""))="" W *7,!!?5,"*** No monitors found for any of the screens !! ***",*7 G EXIT
D DATE^QAMAUTO4
EXIT ;
K QA,QAM,QAMD0,QAMPARAM,QAO,QAOPARAM,QAOS,QAOSD0,QAOSSCRN,QAOSQUIT
K QAQDIC,QAQQUIT,QAQUTIL,^UTILITY($J,"QAO"),^UTILITY($J,"QAM MONITOR")
Q
CHKDEV(X) ; *** CHECK DEVICE FIELDS IN SITE PARAMETERS
Q $S(X="":1,$O(^%ZIS(1,"B",X,0))'>0:1,1:0)
PROBLEM ; *** PROBLEM WITH SITE PARAMETERS
W *7,!!?5,"*****************************************************************",!?5,"* Auto enroll has found important site parameters to be missing *"
W !?5,"* Edit the site parameters and enter the necessary data *",!?5,"*****************************************************************",*7
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOAUTO 2075 printed Apr 09, 2024@21:23:13 Page 2
QAOAUTO ;HISC/DAD-AUTO ENROLL RERUN FOR A DATE RANGE ;6/23/93 09:35
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 SET QAMPARAM=$GET(^QA(740,1,"QAM"))
SET QAOPARAM=$GET(^QA(740,1,"OS"))
+3 FOR QA=3:1:5
IF $SELECT($PIECE(QAMPARAM,"^",QA)="":1,1:0)
DO PROBLEM
GOTO EXIT
+4 IF $$CHKDEV($PIECE($PIECE(QAMPARAM,"^",2),";"))
DO PROBLEM
GOTO EXIT
+5 IF $PIECE(QAOPARAM,"^",9)'>0
IF $$CHKDEV($PIECE($PIECE(QAOPARAM,"^",5),";"))
DO PROBLEM
GOTO EXIT
+6 IF $PIECE(QAOPARAM,"^",9)
SET QAOSQUIT=0
Begin DoDot:1
+7 FOR QA=0:0
SET QA=$ORDER(^QA(740,1,"OS2",QA))
if QA'>0
QUIT
Begin DoDot:2
+8 SET X=$PIECE($PIECE(^QA(740,1,"OS2",QA,0),"^",2),";")
+9 IF $$CHKDEV(X)
DO PROBLEM
SET QAOSQUIT=1
+10 QUIT
End DoDot:2
if QAOSQUIT
QUIT
+11 QUIT
End DoDot:1
if QAOSQUIT
GOTO EXIT
+12 SET QAQDIC="^QA(741.1,"
SET QAQDIC(0)="AEMQZ"
SET QAQUTIL="QAO"
+13 SET QAQDIC("A")="Select AUTO ENROLL SCREEN: "
SET QAQDIC("B")="ALL"
+14 SET QAQDIC("S")="S QAOS=^(0) I '$P(QAOS,""^"",4),$P(QAOS,""^"",5)"
+15 KILL ^UTILITY($JOB,"QAO"),^UTILITY($JOB,"QAM MONITOR")
DO ^QAQSELCT
+16 IF $ORDER(^UTILITY($JOB,"QAO",""))=""
WRITE *7,!!?5,"*** No screens selected !! ***",*7
+17 if QAQQUIT
GOTO EXIT
+18 SET QAOSSCRN=""
FOR
SET QAOSSCRN=$ORDER(^UTILITY($JOB,"QAO",QAOSSCRN))
if QAOSSCRN=""
QUIT
FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^UTILITY($JOB,"QAO",QAOSSCRN,QAOSD0))
if QAOSD0'>0
QUIT
Begin DoDot:1
+19 SET QAO=$GET(^QA(741.1,QAOSD0,0))
+20 SET QAMD0=+$PIECE(QAO,"^",5)
SET QA=$GET(^QA(743,QAMD0,0))
+21 IF QA=""
WRITE !!?5,"*** No monitor found for screen ",QAOSSCRN," !! ***"
QUIT
+22 SET ^UTILITY($JOB,"QAM MONITOR",$PIECE(QA,"^"),QAMD0)=""
+23 QUIT
End DoDot:1
+24 KILL ^UTILITY($JOB,"QAO")
IF $ORDER(^UTILITY($JOB,"QAM MONITOR",""))=""
WRITE *7,!!?5,"*** No monitors found for any of the screens !! ***",*7
GOTO EXIT
+25 DO DATE^QAMAUTO4
EXIT ;
+1 KILL QA,QAM,QAMD0,QAMPARAM,QAO,QAOPARAM,QAOS,QAOSD0,QAOSSCRN,QAOSQUIT
+2 KILL QAQDIC,QAQQUIT,QAQUTIL,^UTILITY($JOB,"QAO"),^UTILITY($JOB,"QAM MONITOR")
+3 QUIT
CHKDEV(X) ; *** CHECK DEVICE FIELDS IN SITE PARAMETERS
+1 QUIT $SELECT(X="":1,$ORDER(^%ZIS(1,"B",X,0))'>0:1,1:0)
PROBLEM ; *** PROBLEM WITH SITE PARAMETERS
+1 WRITE *7,!!?5,"*****************************************************************",!?5,"* Auto enroll has found important site parameters to be missing *"
+2 WRITE !?5,"* Edit the site parameters and enter the necessary data *",!?5,"*****************************************************************",*7
+3 QUIT
