50 lines
2.3 KiB
Mathematica
50 lines
2.3 KiB
Mathematica
|
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
|