~jeff-apple/openvista-gtm-integration/bug368789

XTER1A ;ISC-SF.SEA/JLI MSC/JDS- VA error reporting ;28MAR2006

 ;;8.0;KERNEL;**63,112,120,MSC,IHS**;Jul 10, 1995

 ;

TWO ;

 S XTNUM=2

ONE ;

 S:'$D(XTNUM) XTNUM=1

 S:'$D(XTNDATE) XTNDATE=$H-1 I '$D(ZTQUEUED) S XTNDAT1=$$HTFM^XLFDT(XTNDATE),XTNDAT2=XTNDAT1 G INT^XTER1A1

 K ^TMP($J,"XTER1A") D LISTN,LIST

EXIT K XTNUM,XTNDATE,XTERN,XTERX,X,N,N1,Y,C,XTOUT,Z,I,XTER1AX,XTER1AN,XTER1AN1,%XTZDAT,%XTZNUM,XTMES,XTDV1,XTMES,XTPRNT

 Q

LISTN ;

 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

 .S N1=0 F N=0:0 S N=$O(^TMP($J,"XTER1A",XTERX,N)) Q:N=""  S N1=N I ^(N)=X Q

 .I N="" S ^TMP($J,"XTER1A",XTERX,N1+1)=X,^(N1+1,"CNT")=1,^(1)=XTNDATE_U_XTERN

 .E  S ^("CNT")=^TMP($J,"XTER1A",XTERX,N,"CNT")+1 I ^("CNT")'>XTNUM S Y=^("CNT"),^(Y)=XTNDATE_U_XTERN

 .Q

 Q

LIST ;

 S XTERX="",C=0,XTOUT=0 K ^TMP($J,"XTER")

 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

 .S X=^TMP($J,"XTER1A",XTERX,N) S C=C+1,^TMP($J,"XTER",C)="",C=C+1,^(C)="",Z=$J(^TMP($J,"XTER1A",XTERX,N,"CNT"),8)_"  "

 .F I=1:60 S Y=$E(X,I,I+59) Q:Y=""  S C=C+1,^TMP($J,"XTER",C)=Z_Y,Z="         "

 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

 .F XTER1AN1=0:0 S XTER1AN1=$O(^TMP($J,"XTER1A",XTER1AX,XTER1AN,XTER1AN1)) Q:XTER1AN1'>0  S X=^(XTER1AN1) D

 ..S C=C+1,^TMP($J,"XTER",C)="|PAGE|" S %XTZDAT=+X,%XTZNUM=$P(X,U,2),XTDV1=0 S XTMES=1 D WRT^XTER1

 D:IO=""&$D(^TMP($J,"XTER")) MESSG D:IO'="" WRITER

 K ^TMP($J,"XTER") S C=0 I IO'="" U IO D ^%ZISC

 Q

 ;

MESG N DWPK,DWLW,DIC K ^TMP($J,"XTER"),^TMP($J,"XTER1")

 W @IOF,!!,"Enter any comments to precede the error listing:"

 S DWPK=1,DWLW=75,DIC="^TMP($J,""XTER1""," D EN^DIWE

 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)

 S XTMES=1,XTDV1=0 D WRT^XTER1 D:C>0 MESSG

 S C=0 K XTMES,^TMP($J,"XTER"),^TMP($J,"XTER1")

 G XTERR^XTER

 ;

PRNT K ^TMP($J,"XTER"),ZTIO

 S C=0,%ZIS="MQ" D ^%ZIS I POP D HOME^%ZIS G WRT^XTER1

 I $D(IO("Q")) D  S XTX="" G XTERR^XTER

 . K IO("Q") S ZTRTN="DQPRNT^XTER1A",ZTSAVE("%XTZDAT")="",ZTSAVE("%XTZNUM")="",ZTDESC="XTER1A-PRINT OF ERROR" D ^%ZTLOAD K ZTSK D HOME^%ZIS

 ;

DQPRNT S XTPRNT=1,XTOUT=0 D WRT^XTER1 U IO D:C>0 WRITER

 K ^TMP($J,"XTER"),XTX,XTPRNT S C=0 D ^%ZISC I $D(ZTQUEUED) Q

 G XTERR^XTER

 ;

WRITER 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

 .I $E(%1,1,6)="|PAGE|" W @IOF S %1=$E(%1,7,$L(%1)) Q:%1=""

 .I $E(%1,1,4)="@IOF" W @IOF S %1=$E(%1,5,$L(%1)) Q:%1=""

 .W !,%1

 K %,%1

 Q

MESSG S XMY(DUZ)="",XMDUZ=.5 I '$D(ZTQUEUED) K XMY,XMDUZ

 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)

 D ^XMD K XMY,XMTEXT,XMSUB

 Q

 ;

MORE Q:$G(XTMES)  N DIR,DTOUT,DIRUT,DUOUT

 S XTOUT=0,XTX="" D WRITER K ^TMP($J,"XTER") S C=0

 I '$D(ZTQUEUED),'$G(XTPRNT),$G(IOST)["C-" D

 . S:($D(X)#2) XTMORE=X S DIR(0)="FO^0:50",DIR("A")="     Enter '^' to quit listing, <RETURN> to continue..."

 . D ^DIR K DIR S:$D(DTOUT) X="^" S XTX=X S:$D(XTMORE) X=XTMORE K XTMORE

 I $D(XTX),$E(XTX)="^" S XTOUT=1 Q

 I $G(XTPRNT) W @IOF

 Q

 ;

LST S X=" ",XTQ="" N XTXT,XBLNK S $P(XBLNK," ",80)=" "

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=""

 F  S XTS=$O(^TMP($J,"XTERSCR",XTS)) Q:XTS=""  I XTP[XTS,XTD S XTD=XTD+1 G T1

 ;

 I '(X#20) S %XTERRX=X D MORE Q:XTOUT  Q:XTX>0  D T3 S X=%XTERRX

 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)_" "

 I ^%ZTER(1,%XTZDAT,1,X,"ZE")'["," S XTXT=$J(X,3)_")  "_^("ZE")

 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)

 S X=%XTZNUM S XTXT=$S($L(XTXT)>34:XTXT,1:$E(XTXT_XBLNK,1,34))_%

 I $D(^%ZTER(1,%XTZDAT,1,X,"J")) S XTXT=XTXT_" ["_$P($P(^("J"),U,4),",")_"]" ;_" "_$J($P(^("J"),U,5),7)

 D IHSXQY0 ;***IHS

 W !,$E(XTXT,1,79)

COMMENT I $D(^DD(3.0751,21400)) D  ;**MSC/GFT

 .N DIC,DIQ,DR,DA,Y,S,DK,D0,D1

 .S DIC="^%ZTER(1,"_%XTZDAT_",1,",DIQ(0)="A",DR=21400,DA=X,DA(1)=%XTZDAT

 .I $D(@(DIC_DA_",21400)")) N X D EN^DIQ

 G T1

T2 I XTD W !! I XTD-1 W XTD-1," screened error",$S(XTD-1>1:"s",1:""),!

 ;D MORE

 Q

T3 W !!,?11,"$ZE",?41,"Time",?49,"UCI,VOL",?61,"$J",?69,"$I",!

 Q

INTRACT ;

 G INTRACT^XTER1A1

 ;

 ;

 ;

 ;

IHSXQY0 ;IHS/ANMC/LJF 5/20/99 find option name

 NEW IHS,FOUND,STR

 S (FOUND,IHS)=0,STR=""

 F  S IHS=$O(^%ZTER(1,%XTZDAT,1,X,"ZV",IHS)) Q:'IHS  Q:FOUND  D

 .I $G(^%ZTER(1,%XTZDAT,1,X,"ZV",IHS,0))="DUZ" D  Q

 ..N D,Y S D=$G(^("D")) I D S Y=$P($G(^%ZTER(1,%XTZDAT,1,X,"J")),U,4),Y=$$UCICHECK^%ZOSV(Y) I $L(Y)>2 S Y=$$NAMESP(Y),STR=$P($G(^[Y]VA(200,D,0)),",")_": "

 . Q:$G(^%ZTER(1,%XTZDAT,1,X,"ZV",IHS,0))'="XQY0"

 . S STR=STR_$P($G(^%ZTER(1,%XTZDAT,1,X,"ZV",IHS,"D")),U)

 . S STR=$E(STR,1,26)_$$REPEAT^XLFSTR(" ",(26-$L(STR))),FOUND=1

 S XTXT=XTXT_"  "_$G(STR)

 Q

NAMESP(Y)       ;

 I ^%ZOSF("OS")'["GT.M" Q Y

 Q $ZGB