source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANSUMM.m@ 1801

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1QANSUMM ;HISC/GJC-INCIDENT SUMMARY TO THE REGIONAL DATABASE ;3/25/92
2 ;;2.0;Incident Reporting;;08/07/1992
3 ;
4EN0 ;Entry point, set up server.
5 D EXIT ;Clean up our variables.
6 S QANZERO=$S($D(^QA(740,1,0))#2:^(0),1:0) I +QANZERO'>0 S QANERROR=1 D ERROR G EXIT
7 S QANSITE=+$S($D(^DIC(4,+QANZERO,0))#2:$P(^(0),"^"),1:"") I QANSITE="" S QANERROR=2 D ERROR G EXIT
8 S QANSTNO=$S($D(^DIC(4,+QANZERO,99))#2:$P(^(99),"^"),1:"") I QANSTNO="" S QANERROR=3 D ERROR G EXIT
9 S QANSERV=$P(QANZERO,"^",4) I QANSERV="" S QANERROR=4 D ERROR G EXIT
10 S QANDOM=$P(QANZERO,"^",5) I QANDOM="" S QANERROR=5 D ERROR G EXIT
11 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
12 S QANQAN=$S($D(^QA(740,1,"QAN")):^("QAN"),1:"") I +QANQAN'>0 S QANERROR=7 D ERROR G EXIT
13 S QANMLGP=+$P(QANQAN,U),QANMLGP(0)=$S($D(^XMB(3.8,QANMLGP,0))#2:$P(^(0),U),1:"") I QANMLGP(0)']"" S QANERROR=7 D ERROR G EXIT
14EN1 ;Build data strings.
15 S (QANCNT,QANTAB,QAQQUIT)=0 D QUART^QANQTOT ;Select the quarter of data you wish.
16 I QAQQUIT D EXIT Q
17 S QANDATE=QUBEG(QU),QANEND=QUEND(QU)_".9999999" ;Start/End date of the quarter.
18 S DIE="^QA(742.6,",DR=".17///"_1 ;Set xmitted flag for the incident record.
19 F QAN=(QANDATE-.0000001):0 S QAN=$O(^QA(742.6,"QDATE",QAN)) Q:(QAN>QANEND)!(QAN'>0) F QAY=0:0 S QAY=$O(^QA(742.6,"QDATE",QAN,QAY)) Q:QAY'>0 D EN2
20 I '$D(^UTILITY($J,"QAN SUMM")) W !!?5,*7,"No Incident Summary data found for this quarter." D EXIT Q
21 F QC=0:0 S QC=$O(^UTILITY($J,"QAN SUMM",QC)) Q:QC'>0 D EN3
22 I $D(^UTILITY($J,"QAN INCD SUMM")) D BULL W !!,"Finished"
23EXIT ;
24 D KILL^XM K D,D0,DI,DQ,QAQ2HED,QAQNBEG,QAQEND,QUART,QUEND,QUQUA
25 K DA,DIE,DR,ERROR,QA,QAA,QAN,QAN7426,QANCNT,QANDATE,QANDOM,QANERROR
26 K QANMLGP,QANQAN,QANSERV,QANSITE,QANSTNO,QANTAB,QANX,QANZERO,QAQQUIT
27 K QANEND,QAY,QB,QC,QU,QUBEG,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,YR,^UTILITY($J)
28 K XCNP,XMANS,XMHOLD
29 Q
30BULL ;
31 D KILL^XM
32 ;S QANSERV="CEBELINSKI,GREG",QANDOM="QUA.ISC-CHICAGO.VA.GOV"
33 S XMY(QANSERV_"@"_QANDOM)="",XMSUB=^DD("SITE")_" ("_^DD("SITE",1)_") QAN INCIDENT SUMMARY",XMDUZ=.5
34 S XMTEXT="^UTILITY($J,""QAN INCD SUMM""," D ^XMD,KILL^XM
35 Q
36DEATH ;Instance of death.
37 S ^UTILITY($J,"QAN DEATH",QANTAB)="SUMM^"_QANTAB_"^DEATH^"
38 F QAA=0:0 S QAA=$O(^QA(742.6,QAY,1,QAA)) Q:QAA'>0 S ^UTILITY($J,"QAN DEATH",QANTAB)=^UTILITY($J,"QAN DEATH",QANTAB)_$G(^QA(742.6,QAY,1,QAA,0))_"^"
39 Q
40EN2 ;Set up mail message.
41 S QAN7426=$G(^QA(742.6,QAY,0)) Q:QAN7426']""!($P(QAN7426,U,17)=1)
42 S DA=QAY D ^DIE Q:$D(Y) ;Stuff xmitted, quit on abnormal condition.
43 S QANTAB=QANTAB+1 ;Increment our counter
44 S ^UTILITY($J,"QAN SUMM",QANTAB)="SUMM^"_QANTAB_"^REG^"
45 F QA=1:1:$P(^DD(742.6,0),U,4)-2 S QANX(QA)=$P(QAN7426,U,QA)
46 I $D(^QA(742.1,"BUPPER","DEATH",QANX(4))) D DEATH
47 F QB=1:1:QA S ^UTILITY($J,"QAN SUMM",QANTAB)=^UTILITY($J,"QAN SUMM",QANTAB)_QANX(QB)_"^"
48 Q
49EN3 ;Build final array.
50 S QANCNT=QANCNT+1,^UTILITY($J,"QAN INCD SUMM",QANCNT)=^UTILITY($J,"QAN SUMM",QC)
51 I $D(^UTILITY($J,"QAN DEATH",QC)) S QANCNT=QANCNT+1,^UTILITY($J,"QAN INCD SUMM",QANCNT)=^UTILITY($J,"QAN DEATH",QC)
52 Q
53ERROR ;
54 W *7,!!,"*** ",$P($T(ERR+QANERROR),";;",2)," ***",!!,*7
55 Q
56ERR ;;ERROR MESSAGES: REASONS EWS BULLETIN COULD NOT BE SENT
57 ;;SITE NOT FOUND IN QA SITE PARAMETERS FILE
58 ;;SITE NOT FOUND IN INSTITUTION FILE
59 ;;SITE NUMBER NOT FOUND IN INSTITUTION FILE
60 ;;NQADB MAIL GROUP/SERVER NOT FOUND IN QA SITE PARAMETERS FILE
61 ;;NQADB DOMAIN NOT FOUND IN QA SITE PARAMETERS FILE
62 ;;NQADB DOMAIN NOT FOUND IN DOMAIN FILE
63 ;;QA INCIDENT MAILGROUP NOT FOUND IN QA SITE PARAMETERS FILE
Note: See TracBrowser for help on using the repository browser.