Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: QAOAUTO

QAOAUTO.m

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