| 1 | QAOAUTO ;HISC/DAD-AUTO ENROLL RERUN FOR A DATE RANGE ;6/23/93 09:35
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | S QAMPARAM=$G(^QA(740,1,"QAM")),QAOPARAM=$G(^QA(740,1,"OS"))
|
|---|
| 4 | F QA=3:1:5 I $S($P(QAMPARAM,"^",QA)="":1,1:0) D PROBLEM G EXIT
|
|---|
| 5 | I $$CHKDEV($P($P(QAMPARAM,"^",2),";")) D PROBLEM G EXIT
|
|---|
| 6 | I $P(QAOPARAM,"^",9)'>0,$$CHKDEV($P($P(QAOPARAM,"^",5),";")) D PROBLEM G EXIT
|
|---|
| 7 | I $P(QAOPARAM,"^",9) S QAOSQUIT=0 D G:QAOSQUIT EXIT
|
|---|
| 8 | . F QA=0:0 S QA=$O(^QA(740,1,"OS2",QA)) Q:QA'>0 D Q:QAOSQUIT
|
|---|
| 9 | .. S X=$P($P(^QA(740,1,"OS2",QA,0),"^",2),";")
|
|---|
| 10 | .. I $$CHKDEV(X) D PROBLEM S QAOSQUIT=1
|
|---|
| 11 | .. Q
|
|---|
| 12 | . Q
|
|---|
| 13 | S QAQDIC="^QA(741.1,",QAQDIC(0)="AEMQZ",QAQUTIL="QAO"
|
|---|
| 14 | S QAQDIC("A")="Select AUTO ENROLL SCREEN: ",QAQDIC("B")="ALL"
|
|---|
| 15 | S QAQDIC("S")="S QAOS=^(0) I '$P(QAOS,""^"",4),$P(QAOS,""^"",5)"
|
|---|
| 16 | K ^UTILITY($J,"QAO"),^UTILITY($J,"QAM MONITOR") D ^QAQSELCT
|
|---|
| 17 | I $O(^UTILITY($J,"QAO",""))="" W *7,!!?5,"*** No screens selected !! ***",*7
|
|---|
| 18 | G:QAQQUIT EXIT
|
|---|
| 19 | 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
|
|---|
| 20 | . S QAO=$G(^QA(741.1,QAOSD0,0))
|
|---|
| 21 | . S QAMD0=+$P(QAO,"^",5),QA=$G(^QA(743,QAMD0,0))
|
|---|
| 22 | . I QA="" W !!?5,"*** No monitor found for screen ",QAOSSCRN," !! ***" Q
|
|---|
| 23 | . S ^UTILITY($J,"QAM MONITOR",$P(QA,"^"),QAMD0)=""
|
|---|
| 24 | . Q
|
|---|
| 25 | K ^UTILITY($J,"QAO") I $O(^UTILITY($J,"QAM MONITOR",""))="" W *7,!!?5,"*** No monitors found for any of the screens !! ***",*7 G EXIT
|
|---|
| 26 | D DATE^QAMAUTO4
|
|---|
| 27 | EXIT ;
|
|---|
| 28 | K QA,QAM,QAMD0,QAMPARAM,QAO,QAOPARAM,QAOS,QAOSD0,QAOSSCRN,QAOSQUIT
|
|---|
| 29 | K QAQDIC,QAQQUIT,QAQUTIL,^UTILITY($J,"QAO"),^UTILITY($J,"QAM MONITOR")
|
|---|
| 30 | Q
|
|---|
| 31 | CHKDEV(X) ; *** CHECK DEVICE FIELDS IN SITE PARAMETERS
|
|---|
| 32 | Q $S(X="":1,$O(^%ZIS(1,"B",X,0))'>0:1,1:0)
|
|---|
| 33 | PROBLEM ; *** PROBLEM WITH SITE PARAMETERS
|
|---|
| 34 | W *7,!!?5,"*****************************************************************",!?5,"* Auto enroll has found important site parameters to be missing *"
|
|---|
| 35 | W !?5,"* Edit the site parameters and enter the necessary data *",!?5,"*****************************************************************",*7
|
|---|
| 36 | Q
|
|---|
