| 1 | QANEWS0 ;HISC/GJC-GENERATE `EARLY WARNING SYSTEM' BULLETINS ;7/8/91 11:02
|
|---|
| 2 | ;;2.0;Incident Reporting;**25**;08/07/1992
|
|---|
| 3 | EN1 ; *** MANUAL ENTRY POINT
|
|---|
| 4 | S QANTASK=0
|
|---|
| 5 | G EN
|
|---|
| 6 | EN2 ; *** TASKED ENTRY POINT
|
|---|
| 7 | S QANTASK=1
|
|---|
| 8 | EN S QANZERO=$S($D(^QA(740,1,0))#2:^(0),1:0) I +QANZERO'>0 S QANERROR=1 D ERROR G EXIT
|
|---|
| 9 | S QANSITE=$S($D(^DIC(4,+QANZERO,0))#2:$P(^(0),"^"),1:"") I QANSITE="" S QANERROR=2 D ERROR G EXIT
|
|---|
| 10 | S QANSTNO=$S($D(^DIC(4,+QANZERO,99))#2:$P(^(99),"^"),1:"") I QANSTNO="" S QANERROR=3 D ERROR G EXIT
|
|---|
| 11 | S QANSERV=$P(QANZERO,"^",2) I QANSERV="" S QANERROR=4 D ERROR G EXIT
|
|---|
| 12 | S QANDOM=$P(QANZERO,"^",3) I QANDOM="" S QANERROR=5 D ERROR G EXIT
|
|---|
| 13 | S QA=+$O(^DIC(4.2,"B",QANDOM,0)) I $S('$D(^DIC(4.2,QA,0))#2:1,$P(^(0),"^")'=QANDOM:1,1:0) S ERROR=6 D ERROR G EXIT
|
|---|
| 14 | D:QANTASK MONTH,EN2^QANEWS
|
|---|
| 15 | I 'QANTASK W !!,"Select the reporting period:" D EN1^QANEWS G:QAQQUIT EXIT
|
|---|
| 16 | W:'QANTASK !!,"Finished."
|
|---|
| 17 | EXIT ;
|
|---|
| 18 | K QA,QAN,QAN1,QANIN,QANOUT,ERROR,QANCLIN,QANCREV,QAND0,QAND1,QANDATE
|
|---|
| 19 | K QANDOM,QANEWS,QANFIND,QANLEVL,QANQUIT,QANRFPR,QANSCRN,QANSERV,QANSITE
|
|---|
| 20 | K QANERROR,QANTASK,QANSTNO,QANTEMP,QANVAL,QANZERO,^UTILITY($J)
|
|---|
| 21 | D K^QAQDATE,KILL^XM,KILL^QAQDATE
|
|---|
| 22 | Q
|
|---|
| 23 | ERROR ;
|
|---|
| 24 | W *7,!!,"*** ",$P($T(ERR+QANERROR),";;",2)," ***",!!,*7
|
|---|
| 25 | Q
|
|---|
| 26 | MONTH ;
|
|---|
| 27 | S QANSY=$E(DT,1,3),QANSM=$E(DT,4,5)
|
|---|
| 28 | I QANSM>1 S QANSM=QANSM-1
|
|---|
| 29 | E S QANSM=12,QANSY=QANSY-1
|
|---|
| 30 | S QANSM=$E("0",1,2-$L(QANSM))_QANSM
|
|---|
| 31 | S QAQNBEG=QANSY_QANSM_"01",Y=1700+QANSY,Y=(Y#4=0)&((Y#100)!(Y#400=0))
|
|---|
| 32 | S QAQNEND=QANSY_QANSM_$P("31^28^31^30^31^30^31^31^30^31^30^31",U,+QANSM)+$S(+QANSM=2:Y,1:0)
|
|---|
| 33 | K QANSY,QANSM
|
|---|
| 34 | Q
|
|---|
| 35 | ERR ;;ERROR MESSAGES: REASONS EWS BULLETIN COULD NOT BE SENT
|
|---|
| 36 | ;;SITE NOT FOUND IN QA SITE PARAMETERS FILE
|
|---|
| 37 | ;;SITE NOT FOUND IN INSTITUTION FILE
|
|---|
| 38 | ;;SITE NUMBER NOT FOUND IN INSTITUTION FILE
|
|---|
| 39 | ;;EWS MAIL GROUP/SERVER NOT FOUND IN QA SITE PARAMETERS FILE
|
|---|
| 40 | ;;EWS DOMAIN NOT FOUND IN QA SITE PARAMETERS FILE
|
|---|
| 41 | ;;EWS DOMAIN NOT FOUND IN DOMAIN FILE
|
|---|
