source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANEWS0.m@ 1789

Last change on this file since 1789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1QANEWS0 ;HISC/GJC-GENERATE `EARLY WARNING SYSTEM' BULLETINS ;7/8/91 11:02
2 ;;2.0;Incident Reporting;**25**;08/07/1992
3EN1 ; *** MANUAL ENTRY POINT
4 S QANTASK=0
5 G EN
6EN2 ; *** TASKED ENTRY POINT
7 S QANTASK=1
8EN 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."
17EXIT ;
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
23ERROR ;
24 W *7,!!,"*** ",$P($T(ERR+QANERROR),";;",2)," ***",!!,*7
25 Q
26MONTH ;
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
35ERR ;;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
Note: See TracBrowser for help on using the repository browser.