64 lines
3.5 KiB
Mathematica
64 lines
3.5 KiB
Mathematica
QANSUMM ;HISC/GJC-INCIDENT SUMMARY TO THE REGIONAL DATABASE ;3/25/92
|
|
;;2.0;Incident Reporting;;08/07/1992
|
|
;
|
|
EN0 ;Entry point, set up server.
|
|
D EXIT ;Clean up our variables.
|
|
S QANZERO=$S($D(^QA(740,1,0))#2:^(0),1:0) I +QANZERO'>0 S QANERROR=1 D ERROR G EXIT
|
|
S QANSITE=+$S($D(^DIC(4,+QANZERO,0))#2:$P(^(0),"^"),1:"") I QANSITE="" S QANERROR=2 D ERROR G EXIT
|
|
S QANSTNO=$S($D(^DIC(4,+QANZERO,99))#2:$P(^(99),"^"),1:"") I QANSTNO="" S QANERROR=3 D ERROR G EXIT
|
|
S QANSERV=$P(QANZERO,"^",4) I QANSERV="" S QANERROR=4 D ERROR G EXIT
|
|
S QANDOM=$P(QANZERO,"^",5) I QANDOM="" S QANERROR=5 D ERROR G EXIT
|
|
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
|
|
S QANQAN=$S($D(^QA(740,1,"QAN")):^("QAN"),1:"") I +QANQAN'>0 S QANERROR=7 D ERROR G EXIT
|
|
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
|
|
EN1 ;Build data strings.
|
|
S (QANCNT,QANTAB,QAQQUIT)=0 D QUART^QANQTOT ;Select the quarter of data you wish.
|
|
I QAQQUIT D EXIT Q
|
|
S QANDATE=QUBEG(QU),QANEND=QUEND(QU)_".9999999" ;Start/End date of the quarter.
|
|
S DIE="^QA(742.6,",DR=".17///"_1 ;Set xmitted flag for the incident record.
|
|
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
|
|
I '$D(^UTILITY($J,"QAN SUMM")) W !!?5,*7,"No Incident Summary data found for this quarter." D EXIT Q
|
|
F QC=0:0 S QC=$O(^UTILITY($J,"QAN SUMM",QC)) Q:QC'>0 D EN3
|
|
I $D(^UTILITY($J,"QAN INCD SUMM")) D BULL W !!,"Finished"
|
|
EXIT ;
|
|
D KILL^XM K D,D0,DI,DQ,QAQ2HED,QAQNBEG,QAQEND,QUART,QUEND,QUQUA
|
|
K DA,DIE,DR,ERROR,QA,QAA,QAN,QAN7426,QANCNT,QANDATE,QANDOM,QANERROR
|
|
K QANMLGP,QANQAN,QANSERV,QANSITE,QANSTNO,QANTAB,QANX,QANZERO,QAQQUIT
|
|
K QANEND,QAY,QB,QC,QU,QUBEG,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,YR,^UTILITY($J)
|
|
K XCNP,XMANS,XMHOLD
|
|
Q
|
|
BULL ;
|
|
D KILL^XM
|
|
;S QANSERV="CEBELINSKI,GREG",QANDOM="QUA.ISC-CHICAGO.VA.GOV"
|
|
S XMY(QANSERV_"@"_QANDOM)="",XMSUB=^DD("SITE")_" ("_^DD("SITE",1)_") QAN INCIDENT SUMMARY",XMDUZ=.5
|
|
S XMTEXT="^UTILITY($J,""QAN INCD SUMM""," D ^XMD,KILL^XM
|
|
Q
|
|
DEATH ;Instance of death.
|
|
S ^UTILITY($J,"QAN DEATH",QANTAB)="SUMM^"_QANTAB_"^DEATH^"
|
|
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))_"^"
|
|
Q
|
|
EN2 ;Set up mail message.
|
|
S QAN7426=$G(^QA(742.6,QAY,0)) Q:QAN7426']""!($P(QAN7426,U,17)=1)
|
|
S DA=QAY D ^DIE Q:$D(Y) ;Stuff xmitted, quit on abnormal condition.
|
|
S QANTAB=QANTAB+1 ;Increment our counter
|
|
S ^UTILITY($J,"QAN SUMM",QANTAB)="SUMM^"_QANTAB_"^REG^"
|
|
F QA=1:1:$P(^DD(742.6,0),U,4)-2 S QANX(QA)=$P(QAN7426,U,QA)
|
|
I $D(^QA(742.1,"BUPPER","DEATH",QANX(4))) D DEATH
|
|
F QB=1:1:QA S ^UTILITY($J,"QAN SUMM",QANTAB)=^UTILITY($J,"QAN SUMM",QANTAB)_QANX(QB)_"^"
|
|
Q
|
|
EN3 ;Build final array.
|
|
S QANCNT=QANCNT+1,^UTILITY($J,"QAN INCD SUMM",QANCNT)=^UTILITY($J,"QAN SUMM",QC)
|
|
I $D(^UTILITY($J,"QAN DEATH",QC)) S QANCNT=QANCNT+1,^UTILITY($J,"QAN INCD SUMM",QANCNT)=^UTILITY($J,"QAN DEATH",QC)
|
|
Q
|
|
ERROR ;
|
|
W *7,!!,"*** ",$P($T(ERR+QANERROR),";;",2)," ***",!!,*7
|
|
Q
|
|
ERR ;;ERROR MESSAGES: REASONS EWS BULLETIN COULD NOT BE SENT
|
|
;;SITE NOT FOUND IN QA SITE PARAMETERS FILE
|
|
;;SITE NOT FOUND IN INSTITUTION FILE
|
|
;;SITE NUMBER NOT FOUND IN INSTITUTION FILE
|
|
;;NQADB MAIL GROUP/SERVER NOT FOUND IN QA SITE PARAMETERS FILE
|
|
;;NQADB DOMAIN NOT FOUND IN QA SITE PARAMETERS FILE
|
|
;;NQADB DOMAIN NOT FOUND IN DOMAIN FILE
|
|
;;QA INCIDENT MAILGROUP NOT FOUND IN QA SITE PARAMETERS FILE
|