XQABERR ;ISC-SF.SEA/JLI - TRACK ERRORS IN ALPHA/BETA ROUTINES BACK TO ISC ;7/23/93 12:49
;;8.0;KERNEL;;Jul 10, 1995
DOIT ;
S $P(XQASPAC," ",30)=" " S X="T",%DT="" D ^%DT S XQADT=+Y
F XQAAB=0:0 S XQAAB=$O(^XTV(8989.3,1,"ABPKG",XQAAB)) Q:XQAAB'>0 S XQAPK=+^(XQAAB,0),XQAAD=$P(^(0),U,3),XQAAD=$P(XQAAD,"@",2) I XQAAD'="" D
. S X=+$P(^XTV(8989.3,1,"ABPKG",XQAAB,0),U,5) S:X'>0 X=+$P(^(0),U,2) S $P(^(0),U,5)=XQADT
. D H^%DTC S XQALD=%H-1 D
.. K ^TMP($J) S XQALIN=1
.. X ^%ZOSF("UCI") S ^TMP($J,"A",XQALIN)=Y
.. F XQAK=0:0 S XQAK=$O(^XTV(8989.3,1,"ABPKG",XQAAB,1,XQAK)) Q:XQAK'>0 K XQASTR S XQASTR=^(XQAK,0) I XQASTR'="" D D T9
... F XQAJ=0:0 S XQAJ=$O(^XTV(8989.3,1,"ABPKG",XQAAB,1,XQAK,1,XQAJ)) Q:XQAJ'>0 I $P(^(XQAJ,0),U)'="" S XQASTR(XQAJ)=$P(^(0),U)
. I XQALIN>1 D MAILIT
K %DT,%H,X,XMDUZ,XMSUB,XMTEXT,XMY,XQAA,XQAAB,XQAAD,XQAB,XQABY0,XQABYD,XQABYI,XQABYO,XQABYX,XQAD,XQADT,XQAI,XQAJ,XQAK,XQALD,XQALIN,XQAPK,XQASPAC,XQASTR,XQAX,XQAY,Y
Q
T9 ;
K ^TMP("XQA",$J)
S XQADAT=XQALD F XQAI=0:0 S XQADAT=$O(^%ZTER(1,XQADAT)) Q:XQADAT'>0 F X=0:0 S X=$O(^%ZTER(1,XQADAT,1,X)) Q:X'>0 D
. K XQABY0 S XQABY0="" D S XQABY0=$P(XQABY0,U)
.. F XQAJ=0:0 S XQAJ=$O(^%ZTER(1,XQADAT,1,X,"ZV",XQAJ)) Q:XQAJ'>0 I $D(^(XQAJ,0)),$E(^(0),1,3)="XQY" S XQABYX=^(0) I $D(^("D")) S XQABYD=^("D") D Q:XQABY0'=""
... I XQABYX="XQY",XQABYD'="",$D(^DIC(19,XQABYD,0)) S XQABY0(1)=$P(^(0),U) Q
... I XQABYX="XQY0",XQABYD'="" S XQABY0=XQABYD
.. I XQABY0="",$D(XQABYO(1)) S XQABY0=XQABY0(1)
. I ^%ZTER(1,XQADAT,1,X,"ZE")[(U_XQASTR) S ^TMP("XQA",$J,XQADAT,X)=XQABY0 Q
. I $E(XQABY0,1,$L(XQASTR))=XQASTR S ^TMP("XQA",$J,XQADAT,X)=XQABY0 Q
F XQAI=0:0 S XQAI=$O(^TMP("XQA",$J,XQAI)) Q:XQAI'>0 F X=0:0 S X=$O(^TMP("XQA",$J,XQAI,X)) Q:X'>0 S XQADAT=XQAI,XQAD=0,XQAY=^(X) S:XQAY="" XQAY=" " D
. I ^%ZTER(1,XQADAT,1,X,"ZE")["," S XQAR=$P($P(^("ZE"),",",4),"-",4),XQAR=$P($P(^("ZE"),",",2),"-",3)_$S(XQAR="":"",1:"(")_XQAR_$S(XQAR="":"",1:")")
. S %H=XQADAT,XQAX=X D YMD^%DTC S XQAR(1)=X,X=XQAX
. I ^%ZTER(1,XQADAT,1,X,"ZE")["," S XQAR(2)="<"_XQAR_">"_$P(^%ZTER(1,XQADAT,1,X,"ZE"),",",1)_" "
. I ^%ZTER(1,XQADAT,1,X,"ZE")'["," S XQAR(2)=^("ZE")
. Q:XQAR(2)'[(U_XQASTR)&($E(XQAY,1,$L(XQASTR))'=XQASTR) S ^(XQAR(1))=$G(^TMP($J,"B",XQASTR,XQAR(2),XQAY,XQAR(1)))+1
S XQAA=""
F S XQAA=$O(^TMP($J,"B",XQASTR,XQAA)) Q:XQAA="" S XQAY="" F S XQAY=$O(^TMP($J,"B",XQASTR,XQAA,XQAY)) Q:XQAY="" F XQAD=0:0 S XQAD=$O(^TMP($J,"B",XQASTR,XQAA,XQAY,XQAD)) Q:XQAD'>0 D
. S XQALIN=XQALIN+1,XQAB=XQAA_U S:$L(XQAB)<31 XQAB=$E(XQAB_XQASPAC,1,31) S ^TMP($J,"A",XQALIN)=XQAB_" "_XQAD_" "_^(XQAD)_$S(XQAY'=" ":" "_XQAY,1:"")
Z Q
;
MAILIT ;
S XMY("S.XQAB ERROR LOG SERVER@"_XQAAD)="",XMSUB="ALPHA/BETA TEST ERRORS LOGGED ",XMTEXT="^TMP($J,""A"",",XMDUZ=.5 D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQABERR 2791 printed Dec 13, 2024@02:40:26 Page 2
XQABERR ;ISC-SF.SEA/JLI - TRACK ERRORS IN ALPHA/BETA ROUTINES BACK TO ISC ;7/23/93 12:49
+1 ;;8.0;KERNEL;;Jul 10, 1995
DOIT ;
+1 SET $PIECE(XQASPAC," ",30)=" "
SET X="T"
SET %DT=""
DO ^%DT
SET XQADT=+Y
+2 FOR XQAAB=0:0
SET XQAAB=$ORDER(^XTV(8989.3,1,"ABPKG",XQAAB))
if XQAAB'>0
QUIT
SET XQAPK=+^(XQAAB,0)
SET XQAAD=$PIECE(^(0),U,3)
SET XQAAD=$PIECE(XQAAD,"@",2)
IF XQAAD'=""
Begin DoDot:1
+3 SET X=+$PIECE(^XTV(8989.3,1,"ABPKG",XQAAB,0),U,5)
if X'>0
SET X=+$PIECE(^(0),U,2)
SET $PIECE(^(0),U,5)=XQADT
+4 DO H^%DTC
SET XQALD=%H-1
Begin DoDot:2
+5 KILL ^TMP($JOB)
SET XQALIN=1
+6 XECUTE ^%ZOSF("UCI")
SET ^TMP($JOB,"A",XQALIN)=Y
+7 FOR XQAK=0:0
SET XQAK=$ORDER(^XTV(8989.3,1,"ABPKG",XQAAB,1,XQAK))
if XQAK'>0
QUIT
KILL XQASTR
SET XQASTR=^(XQAK,0)
IF XQASTR'=""
Begin DoDot:3
+8 FOR XQAJ=0:0
SET XQAJ=$ORDER(^XTV(8989.3,1,"ABPKG",XQAAB,1,XQAK,1,XQAJ))
if XQAJ'>0
QUIT
IF $PIECE(^(XQAJ,0),U)'=""
SET XQASTR(XQAJ)=$PIECE(^(0),U)
End DoDot:3
DO T9
End DoDot:2
+9 IF XQALIN>1
DO MAILIT
End DoDot:1
+10 KILL %DT,%H,X,XMDUZ,XMSUB,XMTEXT,XMY,XQAA,XQAAB,XQAAD,XQAB,XQABY0,XQABYD,XQABYI,XQABYO,XQABYX,XQAD,XQADT,XQAI,XQAJ,XQAK,XQALD,XQALIN,XQAPK,XQASPAC,XQASTR,XQAX,XQAY,Y
+11 QUIT
T9 ;
+1 KILL ^TMP("XQA",$JOB)
+2 SET XQADAT=XQALD
FOR XQAI=0:0
SET XQADAT=$ORDER(^%ZTER(1,XQADAT))
if XQADAT'>0
QUIT
FOR X=0:0
SET X=$ORDER(^%ZTER(1,XQADAT,1,X))
if X'>0
QUIT
Begin DoDot:1
+3 KILL XQABY0
SET XQABY0=""
Begin DoDot:2
+4 FOR XQAJ=0:0
SET XQAJ=$ORDER(^%ZTER(1,XQADAT,1,X,"ZV",XQAJ))
if XQAJ'>0
QUIT
IF $DATA(^(XQAJ,0))
IF $EXTRACT(^(0),1,3)="XQY"
SET XQABYX=^(0)
IF $DATA(^("D"))
SET XQABYD=^("D")
Begin DoDot:3
+5 IF XQABYX="XQY"
IF XQABYD'=""
IF $DATA(^DIC(19,XQABYD,0))
SET XQABY0(1)=$PIECE(^(0),U)
QUIT
+6 IF XQABYX="XQY0"
IF XQABYD'=""
SET XQABY0=XQABYD
End DoDot:3
if XQABY0'=""
QUIT
+7 IF XQABY0=""
IF $DATA(XQABYO(1))
SET XQABY0=XQABY0(1)
End DoDot:2
SET XQABY0=$PIECE(XQABY0,U)
+8 IF ^%ZTER(1,XQADAT,1,X,"ZE")[(U_XQASTR)
SET ^TMP("XQA",$JOB,XQADAT,X)=XQABY0
QUIT
+9 IF $EXTRACT(XQABY0,1,$LENGTH(XQASTR))=XQASTR
SET ^TMP("XQA",$JOB,XQADAT,X)=XQABY0
QUIT
End DoDot:1
+10 FOR XQAI=0:0
SET XQAI=$ORDER(^TMP("XQA",$JOB,XQAI))
if XQAI'>0
QUIT
FOR X=0:0
SET X=$ORDER(^TMP("XQA",$JOB,XQAI,X))
if X'>0
QUIT
SET XQADAT=XQAI
SET XQAD=0
SET XQAY=^(X)
if XQAY=""
SET XQAY=" "
Begin DoDot:1
+11 IF ^%ZTER(1,XQADAT,1,X,"ZE")[","
SET XQAR=$PIECE($PIECE(^("ZE"),",",4),"-",4)
SET XQAR=$PIECE($PIECE(^("ZE"),",",2),"-",3)_$SELECT(XQAR="":"",1:"(")_XQAR_$SELECT(XQAR="":"",1:")")
+12 SET %H=XQADAT
SET XQAX=X
DO YMD^%DTC
SET XQAR(1)=X
SET X=XQAX
+13 IF ^%ZTER(1,XQADAT,1,X,"ZE")[","
SET XQAR(2)="<"_XQAR_">"_$PIECE(^%ZTER(1,XQADAT,1,X,"ZE"),",",1)_" "
+14 IF ^%ZTER(1,XQADAT,1,X,"ZE")'[","
SET XQAR(2)=^("ZE")
+15 if XQAR(2)'[(U_XQASTR)&($EXTRACT(XQAY,1,$LENGTH(XQASTR))'=XQASTR)
QUIT
SET ^(XQAR(1))=$GET(^TMP($JOB,"B",XQASTR,XQAR(2),XQAY,XQAR(1)))+1
End DoDot:1
+16 SET XQAA=""
+17 FOR
SET XQAA=$ORDER(^TMP($JOB,"B",XQASTR,XQAA))
if XQAA=""
QUIT
SET XQAY=""
FOR
SET XQAY=$ORDER(^TMP($JOB,"B",XQASTR,XQAA,XQAY))
if XQAY=""
QUIT
FOR XQAD=0:0
SET XQAD=$ORDER(^TMP($JOB,"B",XQASTR,XQAA,XQAY,XQAD))
if XQAD'>0
QUIT
Begin DoDot:1
+18 SET XQALIN=XQALIN+1
SET XQAB=XQAA_U
if $LENGTH(XQAB)<31
SET XQAB=$EXTRACT(XQAB_XQASPAC,1,31)
SET ^TMP($JOB,"A",XQALIN)=XQAB_" "_XQAD_" "_^(XQAD)_$SELECT(XQAY'=" ":" "_XQAY,1:"")
End DoDot:1
Z QUIT
+1 ;
MAILIT ;
+1 SET XMY("S.XQAB ERROR LOG SERVER@"_XQAAD)=""
SET XMSUB="ALPHA/BETA TEST ERRORS LOGGED "
SET XMTEXT="^TMP($J,""A"","
SET XMDUZ=.5
DO ^XMD
+2 QUIT
