source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOAUTO.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1QAOAUTO ;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
27EXIT ;
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
31CHKDEV(X) ; *** CHECK DEVICE FIELDS IN SITE PARAMETERS
32 Q $S(X="":1,$O(^%ZIS(1,"B",X,0))'>0:1,1:0)
33PROBLEM ; *** 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
Note: See TracBrowser for help on using the repository browser.