QAOSEWS0 ;HISC/DAD-GENERATE 'EARLY WARNING SYSTEM' BULLETINS ;5/14/93  07:54
 ;;3.0;Occurrence Screen;;09/14/1993
EN1 S QAOSTASK=0 ; *** MANUAL ENTRY POINT
 G EN
EN2 S QAOSTASK=1 ; *** TASKED ENTRY POINT
EN S QAOSZERO=$G(^QA(740,1,0)) I +QAOSZERO'>0 S QAOERROR=1 D ERROR G EXIT
 S QAOSSITE=$P($G(^DIC(4,+QAOSZERO,0)),"^")
 I QAOSSITE="" S QAOERROR=2 D ERROR G EXIT
 S QAOSSTNO=$P($G(^DIC(4,+QAOSZERO,99)),"^")
 I QAOSSTNO="" S QAOERROR=3 D ERROR G EXIT
 S QAOSSERV=$P(QAOSZERO,"^",2) I QAOSSERV="" S QAOERROR=4 D ERROR G EXIT
 S QAOSDOM=$P(QAOSZERO,"^",3) I QAOSDOM="" S QAOERROR=5 D ERROR G EXIT
 S QA=+$O(^DIC(4.2,"B",$E(QAOSDOM,1,30),0))
 I $S($D(^DIC(4.2,QA,0))[0:1,$P(^(0),"^")'=QAOSDOM:1,1:0) S ERROR=6 D ERROR G EXIT
 S QAOSLGRP=+$P(QAOSZERO,"^",6),QAOSLGRP=$P($G(^XMB(3.8,QAOSLGRP,0)),"^")
 S QAOSLDOM=$G(^XMB("NETNAME"))
 I QAOSTASK D  ; Automatic monthly date range
 . S QAOSY=$E(DT,1,3),QAOSM=$E(DT,4,5)
 . I QAOSM>1 S QAOSM=QAOSM-1
 . E  S QAOSM=12,QAOSY=QAOSY-1
 . S QAOSM=$E("0",1,2-$L(QAOSM))_QAOSM
 . S QAQNBEG=QAOSY_QAOSM_"01",Y=1700+QAOSY,Y=(Y#4=0)&((Y#100)!(Y#400=0))
 . S QAQNEND=QAOSY_QAOSM_$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+QAOSM)+$S(+QAOSM=2:Y,1:0)
 . K QAOSY,QAOSM
 . Q
 I 'QAOSTASK W !!,"Select the reporting period:" S QAQDATE="Monthly" D ^QAQDATE G:QAQQUIT EXIT
 I 'QAOSTASK D WAIT^DICD
 S QAOSLIST(0)="1," D ^QAOSPSM0
 D EN^QAOSEWS1
EXIT ;
 K %,%ZIS,DIR,DIRUT,ERROR,POP,QA,QAO,QAOBLANK,QAOERROR,QAOPART2,QAOS
 K QAOSACTN,QAOSCLIN,QAOSCREV,QAOSCRN,QAOSD0,QAOSD1,QAOSDATA,QAOSDATE
 K QAOSDOM,QAOSEWS,QAOSFIND,QAOSLDOM,QAOSLEVL,QAOSLGRP,QAOSLIST,QAOSLST
 K QAOSM,QAOSMGMT,QAOSNUM,QAOSPEER,QAOSQUIT,QAOSRFPR,QAOSS1,QAOSS2
 K QAOSSCRN,QAOSSEQ,QAOSSERV,QAOSSITE,QAOSSTAT,QAOSSTNO,QAOSTASK,QAOSTEMP
 K QAOSTEXT,QAOSY,QAOSZERO,TAB,UNDL,X,Y,ZTRTN,ZTSAVE
 K ^UTILITY($J,"QAOSPSM"),^UTILITY($J,"QAOSXREF"),^UTILITY($J,"QAOSPEND")
 D K^QAQDATE,KILL^XM S:$D(ZTQUEUED) ZTREQ="@"
 Q
ERROR ;
 W:'QAOSTASK *7,!!,"*** ",$P($T(ERR+QAOERROR),";;",2)," ***",!!,*7
 Q
ERR ;;ERROR MESSAGES: REASONS EWS BULLETIN COULD NOT BE SENT
 ;;STATION NAME NOT FOUND IN QA SITE PARAMETERS FILE
 ;;STATION NAME NOT FOUND IN INSTITUTION FILE
 ;;STATION NUMBER NOT FOUND IN INSTITUTION FILE
 ;;EWS MAIL GROUP/SERVER NOT FOUND IN QA SITE PARAMETERS FILE
 ;;EWS DOMAIN NOT FOUND IN QA SITE PARAMETERS FILE
 ;;EWS DOMAIN NOT FOUND IN DOMAIN FILE