Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTER1A

XTER1A.m

Go to the documentation of this file.
  1. XTER1A ;ISC-SF.SEA/JLI - VA error reporting ;05/20/10 15:53
  1. ;;8.0;KERNEL;**63,112,120,431**;Jul 10, 1995;Build 35
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. TWO ;Print two of each error
  1. S XTNUM=2
  1. ONE ;Print one of each error
  1. S:'$D(XTNUM) XTNUM=1
  1. S:'$D(XTNDATE) XTNDATE=$H-1 I '$D(ZTQUEUED) S XTNDAT1=$$HTFM^XLFDT(XTNDATE),XTNDAT2=XTNDAT1 G INT^XTER1A1
  1. K ^TMP($J,"XTER1A") D LISTN,LIST
  1. EXIT K XTNUM,XTNDATE,XTERN,XTERX,X,N,N1,Y,C,XTOUT,Z,I,XTER1AX,XTER1AN,XTER1AN1,%XTZDAT,%XTZNUM,XTMES,XTDV1,XTMES,XTPRNT
  1. Q
  1. LISTN ;Sort errors
  1. F XTERN=0:0 S XTERN=$O(^%ZTER(1,XTNDATE,1,XTERN)) Q:XTERN'>0 I $D(^(XTERN,"ZE")) S XTERX=$E(^("ZE"),1,30),X=^("ZE") D
  1. .S N1=0 F N=0:0 S N=$O(^TMP($J,"XTER1A",XTERX,N)) Q:N="" S N1=N I ^(N)=X Q
  1. .I N="" S ^TMP($J,"XTER1A",XTERX,N1+1)=X,^(N1+1,"CNT")=1,^(1)=XTNDATE_U_XTERN
  1. .E S ^("CNT")=^TMP($J,"XTER1A",XTERX,N,"CNT")+1 I ^("CNT")'>XTNUM S Y=^("CNT"),^(Y)=XTNDATE_U_XTERN
  1. .Q
  1. Q
  1. LIST ;
  1. S XTERX="",C=0,XTOUT=0 K ^TMP($J,"XTER")
  1. ;List count of errors
  1. F S XTERX=$O(^TMP($J,"XTER1A",XTERX)) Q:XTERX="" F N=0:0 S N=$O(^TMP($J,"XTER1A",XTERX,N)) Q:N'>0 D
  1. .S X=^TMP($J,"XTER1A",XTERX,N) D ADD(""),ADD("") S Z=$J(^TMP($J,"XTER1A",XTERX,N,"CNT"),8)_" "
  1. .F I=1:60 S Y=$E(X,I,I+59) Q:Y="" D ADD(Z_Y) S Z=" "
  1. .Q
  1. ;List errors
  1. S XTER1AX="" F S XTER1AX=$O(^TMP($J,"XTER1A",XTER1AX)) Q:XTER1AX="" F XTER1AN=0:0 S XTER1AN=$O(^TMP($J,"XTER1A",XTER1AX,XTER1AN)) Q:XTER1AN'>0 D
  1. .F XTER1AN1=0:0 S XTER1AN1=$O(^TMP($J,"XTER1A",XTER1AX,XTER1AN,XTER1AN1)) Q:XTER1AN1'>0 S X=^(XTER1AN1) D
  1. ..D ADD("|PAGE|") S %XTZDAT=+X,%XTZNUM=$P(X,U,2),XTDV1=0 S XTMES=1 D WRT^XTER1
  1. D:IO=""&$D(^TMP($J,"XTER")) MESSG D:IO'="" WRITER
  1. K ^TMP($J,"XTER") S C=0 I IO'="" U IO D ^%ZISC
  1. Q
  1. ;
  1. MESG ;Send to a Mail message
  1. N DWPK,DWLW,DIC K ^TMP($J,"XTER"),^TMP($J,"XTER1")
  1. W @IOF,!!,"Enter any comments to precede the error listing:"
  1. S DWPK=1,DWLW=75,DIC="^TMP($J,""XTER1"",",DIWESUB="Comments" D EN^DIWE
  1. S C=0 W ! F I=0:0 S I=$O(^TMP($J,"XTER1",I)) Q:I'>0 S C=I,^TMP($J,"XTER",I)=^TMP($J,"XTER1",I,0)
  1. S XTMES=1,XTDV1=0 D WRT^XTER1 D:C>0 MESSG
  1. S C=0,XTX="" K XTMES,^TMP($J,"XTER"),^TMP($J,"XTER1")
  1. G XTERR^XTER
  1. ;
  1. PRNT ;Send to Printer
  1. K ^TMP($J,"XTER"),ZTIO,XTDV1
  1. S C=0,%ZIS="MQ" D ^%ZIS I POP D HOME^%ZIS G WRT^XTER1
  1. I $D(IO("Q")) D S XTX="" G XTERR^XTER
  1. . K IO("Q") S ZTRTN="DQPRNT^XTER1A",ZTSAVE("%XTZDAT")="",ZTSAVE("%XTZNUM")="",ZTDESC="XTER1A-PRINT OF ERROR" D ^%ZTLOAD K ZTSK D HOME^%ZIS
  1. ;
  1. DQPRNT S XTPRNT=1,XTOUT=0 D WRT^XTER1 U IO D:C>0 WRITER
  1. K ^TMP($J,"XTER"),XTX,XTPRNT S C=0 D ^%ZISC I $D(ZTQUEUED) Q
  1. G XTERR^XTER
  1. ;
  1. WRITER ;Write global
  1. F %=0:0 S %=$O(^TMP($J,"XTER",%)) Q:%'>0 W:((IOSL-$Y)'>4&$G(XTPRNT)) @IOF S %1=$S($D(^(%))=1:^(%),1:^(%,0)) D
  1. .I $E(%1,1,6)="|PAGE|" W @IOF S %1=$E(%1,7,$L(%1)) Q:%1=""
  1. .I $E(%1,1,4)="@IOF" W @IOF S %1=$E(%1,5,$L(%1)) Q:%1=""
  1. .F Q:%1="" W !,$E(%1,1,IOM) S %1=$E(%1,IOM+1,$L(%1))
  1. K %,%1
  1. Q
  1. MESSG ;Global to Message
  1. S XMY(DUZ)="",XMDUZ=.5 I '$D(ZTQUEUED) K XMY,XMDUZ
  1. S XMTEXT="^TMP($J,""XTER"",",XMSUB="ERROR - "_$E(%XTZE,1,40) F Q:XMSUB'[U S XMSUB=$P(XMSUB,U)_"~U~"_$P(XMSUB,U,2,99)
  1. D ^XMD K XMY,XMTEXT,XMSUB
  1. Q
  1. ;
  1. ADD(STR) ;Add STR to TMP global
  1. S C=C+1,^TMP($J,"XTER",C)=STR
  1. Q
  1. ;
  1. MORE Q:$G(XTMES) N DIR,DTOUT,DIRUT,DUOUT
  1. S XTOUT=0,XTX="" D WRITER K ^TMP($J,"XTER") S C=0
  1. I '$D(ZTQUEUED),'$G(XTPRNT),$G(IOST)["C-" D
  1. . S:($D(X)#2) XTMORE=X S DIR(0)="FO^0:50",DIR("A")=" Enter '^' to quit listing, <RETURN> to continue..."
  1. . D ^DIR K DIR S:$D(DTOUT) X="^" S XTX=X S:$D(XTMORE) X=XTMORE K XTMORE
  1. I $D(XTX),$E(XTX)="^" S XTOUT=1 Q
  1. I $G(XTPRNT) W @IOF
  1. Q
  1. ;
  1. LST S X=" ",XTQ="" N XTXT,XBLNK S $P(XBLNK," ",80)=" "
  1. T1 S X=$O(^%ZTER(1,%XTZDAT,1,X),-1) R XTQ:0 Q:XTQ'="" G T2:X'>0,T1:'($D(^(X,"ZE"))#2) S XTP=^("ZE"),XTS=""
  1. F S XTS=$O(^TMP($J,"XTERSCR",XTS)) Q:XTS="" I XTP[XTS,XTD S XTD=XTD+1 G T1
  1. ;
  1. I '(X#20) S %XTERRX=X D MORE Q:XTOUT Q:XTX>0 D T3 S X=%XTERRX
  1. I ^%ZTER(1,%XTZDAT,1,X,"ZE")["," S %XTERR=$P($P(^("ZE"),",",4),"-",4),%XTERR=$P($P(^("ZE"),",",2),"-",3)_$S(%XTERR="":"",1:"(")_%XTERR_$S(%XTERR="":"",1:")") S XTXT=$J(X,3)_") "_"<"_%XTERR_">"_$P(^("ZE"),",",1)_" "
  1. I ^%ZTER(1,%XTZDAT,1,X,"ZE")'["," S XTXT=$J(X,3)_") "_^("ZE")
  1. S %XTZNUM=X,%="" I $D(^%ZTER(1,%XTZDAT,1,%XTZNUM,"H")) S %H=^("H") D YMD^%DTC S %=$P(%,".",2)_"000000",%=$E(%,1,2)_":"_$E(%,3,4)_":"_$E(%,5,6)
  1. S X=%XTZNUM S XTXT=$S($L(XTXT)>38:XTXT,1:$E(XTXT_XBLNK,1,38))_%
  1. S XTXT=XTXT_" "_$P($S('$D(^%ZTER(1,%XTZDAT,1,X,"J")):"",1:^("J")),U,4)_" "_$J($P($S('$D(^("J")):"",1:^("J")),U,5),7)_" "_$P($S('$D(^("I")):"",1:^("I")),U)
  1. S XTXT=$S($L(XTXT)>51:XTXT,1:$E(XTXT_XBLNK,1,51))_$P(XTP,"\",7)
  1. S XTXT=$S($L(XTXT)>59:XTXT,1:$E(XTXT_XBLNK,1,60))_$P(XTP,"\",3) S XTXT=$S($L(XTXT)>65:XTXT,1:$E(XTXT_XBLNK,1,65))_$P(XTP,"\",4) W !,$E(XTXT,1,79) G T1
  1. T2 I XTD W !!,$S(XTD-1:XTD-1,1:"No")," screened error",$S(XTD-1>1:"s",1:""),!
  1. D MORE
  1. Q
  1. T3 W !!,?11,"$ZE",?41,"Time",?49,"UCI,VOL",?61,"$J",?69,"$I",!
  1. Q
  1. INTRACT ;
  1. G INTRACT^XTER1A1