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.DOMAIN.EXT"
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANSUMM 3614 printed Apr 09, 2024@21:01:49 Page 2
QANSUMM ;HISC/GJC-INCIDENT SUMMARY TO THE REGIONAL DATABASE ;3/25/92
+1 ;;2.0;Incident Reporting;;08/07/1992
+2 ;
EN0 ;Entry point, set up server.
+1 ;Clean up our variables.
DO EXIT
+2 SET QANZERO=$SELECT($DATA(^QA(740,1,0))#2:^(0),1:0)
IF +QANZERO'>0
SET QANERROR=1
DO ERROR
GOTO EXIT
+3 SET QANSITE=+$SELECT($DATA(^DIC(4,+QANZERO,0))#2:$PIECE(^(0),"^"),1:"")
IF QANSITE=""
SET QANERROR=2
DO ERROR
GOTO EXIT
+4 SET QANSTNO=$SELECT($DATA(^DIC(4,+QANZERO,99))#2:$PIECE(^(99),"^"),1:"")
IF QANSTNO=""
SET QANERROR=3
DO ERROR
GOTO EXIT
+5 SET QANSERV=$PIECE(QANZERO,"^",4)
IF QANSERV=""
SET QANERROR=4
DO ERROR
GOTO EXIT
+6 SET QANDOM=$PIECE(QANZERO,"^",5)
IF QANDOM=""
SET QANERROR=5
DO ERROR
GOTO EXIT
+7 SET QA=+$ORDER(^DIC(4.2,"B",QANDOM,0))
IF $SELECT('$DATA(^DIC(4.2,QA,0))#2:1,$PIECE(^(0),"^")'=QANDOM:1,1:0)
SET ERROR=6
DO ERROR
GOTO EXIT
+8 SET QANQAN=$SELECT($DATA(^QA(740,1,"QAN")):^("QAN"),1:"")
IF +QANQAN'>0
SET QANERROR=7
DO ERROR
GOTO EXIT
+9 SET QANMLGP=+$PIECE(QANQAN,U)
SET QANMLGP(0)=$SELECT($DATA(^XMB(3.8,QANMLGP,0))#2:$PIECE(^(0),U),1:"")
IF QANMLGP(0)']""
SET QANERROR=7
DO ERROR
GOTO EXIT
EN1 ;Build data strings.
+1 ;Select the quarter of data you wish.
SET (QANCNT,QANTAB,QAQQUIT)=0
DO QUART^QANQTOT
+2 IF QAQQUIT
DO EXIT
QUIT
+3 ;Start/End date of the quarter.
SET QANDATE=QUBEG(QU)
SET QANEND=QUEND(QU)_".9999999"
+4 ;Set xmitted flag for the incident record.
SET DIE="^QA(742.6,"
SET DR=".17///"_1
+5 FOR QAN=(QANDATE-.0000001):0
SET QAN=$ORDER(^QA(742.6,"QDATE",QAN))
if (QAN>QANEND)!(QAN'>0)
QUIT
FOR QAY=0:0
SET QAY=$ORDER(^QA(742.6,"QDATE",QAN,QAY))
if QAY'>0
QUIT
DO EN2
+6 IF '$DATA(^UTILITY($JOB,"QAN SUMM"))
WRITE !!?5,*7,"No Incident Summary data found for this quarter."
DO EXIT
QUIT
+7 FOR QC=0:0
SET QC=$ORDER(^UTILITY($JOB,"QAN SUMM",QC))
if QC'>0
QUIT
DO EN3
+8 IF $DATA(^UTILITY($JOB,"QAN INCD SUMM"))
DO BULL
WRITE !!,"Finished"
EXIT ;
+1 DO KILL^XM
KILL D,D0,DI,DQ,QAQ2HED,QAQNBEG,QAQEND,QUART,QUEND,QUQUA
+2 KILL DA,DIE,DR,ERROR,QA,QAA,QAN,QAN7426,QANCNT,QANDATE,QANDOM,QANERROR
+3 KILL QANMLGP,QANQAN,QANSERV,QANSITE,QANSTNO,QANTAB,QANX,QANZERO,QAQQUIT
+4 KILL QANEND,QAY,QB,QC,QU,QUBEG,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,YR,^UTILITY($JOB)
+5 KILL XCNP,XMANS,XMHOLD
+6 QUIT
BULL ;
+1 DO KILL^XM
+2 ;S QANSERV="CEBELINSKI,GREG",QANDOM="QUA.ISC-CHICAGO.DOMAIN.EXT"
+3 SET XMY(QANSERV_"@"_QANDOM)=""
SET XMSUB=^DD("SITE")_" ("_^DD("SITE",1)_") QAN INCIDENT SUMMARY"
SET XMDUZ=.5
+4 SET XMTEXT="^UTILITY($J,""QAN INCD SUMM"","
DO ^XMD
DO KILL^XM
+5 QUIT
DEATH ;Instance of death.
+1 SET ^UTILITY($JOB,"QAN DEATH",QANTAB)="SUMM^"_QANTAB_"^DEATH^"
+2 FOR QAA=0:0
SET QAA=$ORDER(^QA(742.6,QAY,1,QAA))
if QAA'>0
QUIT
SET ^UTILITY($JOB,"QAN DEATH",QANTAB)=^UTILITY($JOB,"QAN DEATH",QANTAB)_$GET(^QA(742.6,QAY,1,QAA,0))_"^"
+3 QUIT
EN2 ;Set up mail message.
+1 SET QAN7426=$GET(^QA(742.6,QAY,0))
if QAN7426']""!($PIECE(QAN7426,U,17)=1)
QUIT
+2 ;Stuff xmitted, quit on abnormal condition.
SET DA=QAY
DO ^DIE
if $DATA(Y)
QUIT
+3 ;Increment our counter
SET QANTAB=QANTAB+1
+4 SET ^UTILITY($JOB,"QAN SUMM",QANTAB)="SUMM^"_QANTAB_"^REG^"
+5 FOR QA=1:1:$PIECE(^DD(742.6,0),U,4)-2
SET QANX(QA)=$PIECE(QAN7426,U,QA)
+6 IF $DATA(^QA(742.1,"BUPPER","DEATH",QANX(4)))
DO DEATH
+7 FOR QB=1:1:QA
SET ^UTILITY($JOB,"QAN SUMM",QANTAB)=^UTILITY($JOB,"QAN SUMM",QANTAB)_QANX(QB)_"^"
+8 QUIT
EN3 ;Build final array.
+1 SET QANCNT=QANCNT+1
SET ^UTILITY($JOB,"QAN INCD SUMM",QANCNT)=^UTILITY($JOB,"QAN SUMM",QC)
+2 IF $DATA(^UTILITY($JOB,"QAN DEATH",QC))
SET QANCNT=QANCNT+1
SET ^UTILITY($JOB,"QAN INCD SUMM",QANCNT)=^UTILITY($JOB,"QAN DEATH",QC)
+3 QUIT
ERROR ;
+1 WRITE *7,!!,"*** ",$PIECE($TEXT(ERR+QANERROR),";;",2)," ***",!!,*7
+2 QUIT
ERR ;;ERROR MESSAGES: REASONS EWS BULLETIN COULD NOT BE SENT
+1 ;;SITE NOT FOUND IN QA SITE PARAMETERS FILE
+2 ;;SITE NOT FOUND IN INSTITUTION FILE
+3 ;;SITE NUMBER NOT FOUND IN INSTITUTION FILE
+4 ;;NQADB MAIL GROUP/SERVER NOT FOUND IN QA SITE PARAMETERS FILE
+5 ;;NQADB DOMAIN NOT FOUND IN QA SITE PARAMETERS FILE
+6 ;;NQADB DOMAIN NOT FOUND IN DOMAIN FILE
+7 ;;QA INCIDENT MAILGROUP NOT FOUND IN QA SITE PARAMETERS FILE
