source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANSUMM.m@ 1318

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