- 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 Jan 18, 2025@03:22:07 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