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