- XQABERR ;ISC-SF.SEA/JLI - TRACK ERRORS IN ALPHA/BETA ROUTINES BACK TO ISC ;7/23/93 12:49 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XQABERR ;ISC-SF.SEA/JLI - TRACK ERRORS IN ALPHA/BETA ROUTINES BACK TO ISC ;7/23/93 12:49 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;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
