- XTER2 ;ISC-SF.SEA/JLI - MODIFICATION OF %XTER FOR USE WITH VAX DSM ;03/08/2012
- ;;8.0;KERNEL;**71,77,582**;Jul 10, 1995;Build 6
- ;Per VHA Directive 2004-038, this routine should not be modified
- RESTOR ;
- X ^%ZOSF("PROGMODE") I 'Y W !,$C(7),"^R to restore environment is restricted to users in programmer mode",$C(7),! G ^XTER1
- S %XTZUCI=$P(%XTJOB,U,4) X ^%ZOSF("UCI") I $P(Y,",")'=$P(%XTZUCI,":"),$P(Y,",",2)'=$P(%XTZUCI,":") K %XTZUCI
- F %XTZZZ=0:0 S %XTZZZ=$O(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",%XTZZZ)) Q:%XTZZZ'>0 I $D(^(%XTZZZ,"D"))#2,$D(^(0))#2,$E(^(0))'="$" I $E(^(0),1,6)'="%ZT(""^",$E(^(0),1)'="^" S @(^(0))=^("D")
- I '$D(%XTZUCI) W !,$C(7),"MUST BE IN SAME UCI TO RESTORE PROGRAM --- VARIABLES RESTORED",! K %XTZDAT,%XTZNUM,%XTZZZ Q
- S X=$P($P($P(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZE"),",",1),"^",2),":",1) I X'="" X ^%ZOSF("TEST") I $T S XCNP=0,DIF="^TMP($J," X ^%ZOSF("LOAD") K XCNP,DIF,^TMP($J)
- W !,"VARIABLES RESTORED"
- K %XTZZZ,%XTZDAT,%XTZNUM,%XTZUCI
- Q
- ;
- SLIST ;
- S XTSTR1=0 R !!,"Enter part of error or routine to be matched: ",XTSTR:DTIME Q:'$T!(XTSTR="")!(XTSTR="^") D T11
- D T13 F XTI=0:0 Q:XTOUT S XTI=$O(^TMP("XTER",$J,XTI)) Q:XTI'>0 F X=0:0 S X=$O(^TMP("XTER",$J,XTI,X)) Q:X'>0 S %XTZDAT=^(X),XTSTR1=XTSTR1+1,XTD=0 S %XTYL=%XTYL-1 D:'%XTYL MORE^XTER1A Q:XTOUT D:'%XTYL T11 W:'%XTYL ! D T10
- I XTSTR1=0 W !!?10,XTSTR," not found in error log",!
- K XTSTR,XTSTR1
- Z Q
- T10 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 %XTERR(1)=$H-%XTZDAT,%XTERR(1)="T"_$S(%XTERR(1)=0:"",1:"-"_%XTERR(1)),%XTERR(1)=$E(%XTERR(1)_" ",1,5)_" #"
- I ^%ZTER(1,%XTZDAT,1,X,"ZE")["," W !,%XTERR(1),$J(X,3),") ","<",%XTERR,">",$P(^%ZTER(1,%XTZDAT,1,X,"ZE"),",",1)_" "
- I ^%ZTER(1,%XTZDAT,1,X,"ZE")'["," W !,%XTERR(1),$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 W ?39,%
- W " ",$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)
- Q
- T11 W !!,"Date",?6,"ErrNum",?17,"$ZE",?41,"Time",?49,"UCI/VOL",?61,"$J",?69,"$I" S %XTYL=IOSL-6
- Q
- ;
- T13 K ^TMP("XTER",$J) S %XTZDAT=0 F XTI=0:0 S %XTZDAT=$O(^%ZTER(1,%XTZDAT)) Q:%XTZDAT'>0 F X=0:0 S X=$O(^%ZTER(1,%XTZDAT,1,X)) Q:X'>0 I $D(^(X,"ZE")),^("ZE")[XTSTR S ^TMP("XTER",$J,(99999-%XTZDAT),X)=%XTZDAT
- Q
- UDD ;Convert user date
- K XTDTE,XTDTH,XTERR N %XTF,%XTY,X,Y
- G T:%XTZDAT?1"T".E,T:%XTZDAT?1"t".E
- S %XTF=$TR(%XTZDAT,$C(32,44,45,46),"////")
- B S %XTY="//" D R
- S X=%XTF,%DT="XP",%DT(0)="-NOW" D ^%DT K %DT I Y'>0 S XTERR=1 K XTDTE,XTDTH G K
- S XTDTH=+$$FMTH^XLFDT(Y),XTDTE=$$FMTE^XLFDT(Y,5)
- K Q
- E S XTERR=1 K XTDTH,XTDTE G K
- R Q:%XTF'[%XTY S %XTF=$P(%XTF,%XTY,1)_"/"_$P(%XTF,%XTY,2,256) G R
- ;
- T S %XTT=$E(%XTZDAT,2,99) I %XTT'="" G E:%XTT?7E.E,E:%XTT'?1"-"1N.N&(%XTT'?1"+"1N.N)
- S XTDTH=$P($H,",",1)+%XTT G E:XTDTH<0 D UDA S XTDTH=-XTDTH G K
- ;
- UDA ;
- I '$D(XTDTH) S XTDTH=$P($H,",",1)
- S XTDTE=$$HTE^XLFDT(XTDTH,5)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTER2 3155 printed Mar 13, 2025@21:45:50 Page 2
- XTER2 ;ISC-SF.SEA/JLI - MODIFICATION OF %XTER FOR USE WITH VAX DSM ;03/08/2012
- +1 ;;8.0;KERNEL;**71,77,582**;Jul 10, 1995;Build 6
- +2 ;Per VHA Directive 2004-038, this routine should not be modified
- RESTOR ;
- +1 XECUTE ^%ZOSF("PROGMODE")
- IF 'Y
- WRITE !,$CHAR(7),"^R to restore environment is restricted to users in programmer mode",$CHAR(7),!
- GOTO ^XTER1
- +2 SET %XTZUCI=$PIECE(%XTJOB,U,4)
- XECUTE ^%ZOSF("UCI")
- IF $PIECE(Y,",")'=$PIECE(%XTZUCI,":")
- IF $PIECE(Y,",",2)'=$PIECE(%XTZUCI,":")
- KILL %XTZUCI
- +3 FOR %XTZZZ=0:0
- SET %XTZZZ=$ORDER(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZV",%XTZZZ))
- if %XTZZZ'>0
- QUIT
- IF $DATA(^(%XTZZZ,"D"))#2
- IF $DATA(^(0))#2
- IF $EXTRACT(^(0))'="$"
- IF $EXTRACT(^(0),1,6)'="%ZT(""^"
- IF $EXTRACT(^(0),1)'="^"
- SET @(^(0))=^("D")
- +4 IF '$DATA(%XTZUCI)
- WRITE !,$CHAR(7),"MUST BE IN SAME UCI TO RESTORE PROGRAM --- VARIABLES RESTORED",!
- KILL %XTZDAT,%XTZNUM,%XTZZZ
- QUIT
- +5 SET X=$PIECE($PIECE($PIECE(^%ZTER(1,%XTZDAT,1,%XTZNUM,"ZE"),",",1),"^",2),":",1)
- IF X'=""
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- SET XCNP=0
- SET DIF="^TMP($J,"
- XECUTE ^%ZOSF("LOAD")
- KILL XCNP,DIF,^TMP($JOB)
- +6 WRITE !,"VARIABLES RESTORED"
- +7 KILL %XTZZZ,%XTZDAT,%XTZNUM,%XTZUCI
- +8 QUIT
- +9 ;
- SLIST ;
- +1 SET XTSTR1=0
- READ !!,"Enter part of error or routine to be matched: ",XTSTR:DTIME
- if '$TEST!(XTSTR="")!(XTSTR="^")
- QUIT
- DO T11
- +2 DO T13
- FOR XTI=0:0
- if XTOUT
- QUIT
- SET XTI=$ORDER(^TMP("XTER",$JOB,XTI))
- if XTI'>0
- QUIT
- FOR X=0:0
- SET X=$ORDER(^TMP("XTER",$JOB,XTI,X))
- if X'>0
- QUIT
- SET %XTZDAT=^(X)
- SET XTSTR1=XTSTR1+1
- SET XTD=0
- SET %XTYL=%XTYL-1
- if '%XTYL
- DO MORE^XTER1A
- if XTOUT
- QUIT
- if '%XTYL
- DO T11
- if '%XTYL
- WRITE !
- DO T10
- +3 IF XTSTR1=0
- WRITE !!?10,XTSTR," not found in error log",!
- +4 KILL XTSTR,XTSTR1
- Z QUIT
- T10 IF ^%ZTER(1,%XTZDAT,1,X,"ZE")[","
- SET %XTERR=$PIECE($PIECE(^("ZE"),",",4),"-",4)
- SET %XTERR=$PIECE($PIECE(^("ZE"),",",2),"-",3)_$SELECT(%XTERR="":"",1:"(")_%XTERR_$SELECT(%XTERR="":"",1:")")
- +1 SET %XTERR(1)=$HOROLOG-%XTZDAT
- SET %XTERR(1)="T"_$SELECT(%XTERR(1)=0:"",1:"-"_%XTERR(1))
- SET %XTERR(1)=$EXTRACT(%XTERR(1)_" ",1,5)_" #"
- +2 IF ^%ZTER(1,%XTZDAT,1,X,"ZE")[","
- WRITE !,%XTERR(1),$JUSTIFY(X,3),") ","<",%XTERR,">",$PIECE(^%ZTER(1,%XTZDAT,1,X,"ZE"),",",1)_" "
- +3 IF ^%ZTER(1,%XTZDAT,1,X,"ZE")'[","
- WRITE !,%XTERR(1),$JUSTIFY(X,3),") ",^("ZE")
- +4 SET %XTZNUM=X
- SET %=""
- IF $DATA(^%ZTER(1,%XTZDAT,1,%XTZNUM,"H"))
- SET %H=^("H")
- DO YMD^%DTC
- SET %=$PIECE(%,".",2)_"000000"
- SET %=$EXTRACT(%,1,2)_":"_$EXTRACT(%,3,4)_":"_$EXTRACT(%,5,6)
- +5 SET X=%XTZNUM
- WRITE ?39,%
- +6 WRITE " ",$PIECE($SELECT('$DATA(^%ZTER(1,%XTZDAT,1,X,"J")):"",1:^("J")),U,4)," ",$JUSTIFY($PIECE($SELECT('$DATA(^("J")):"",1:^("J")),U,5),7)," ",$PIECE($SELECT('$DATA(^("I")):"",1:^("I")),U)
- +7 QUIT
- T11 WRITE !!,"Date",?6,"ErrNum",?17,"$ZE",?41,"Time",?49,"UCI/VOL",?61,"$J",?69,"$I"
- SET %XTYL=IOSL-6
- +1 QUIT
- +2 ;
- T13 KILL ^TMP("XTER",$JOB)
- SET %XTZDAT=0
- FOR XTI=0:0
- SET %XTZDAT=$ORDER(^%ZTER(1,%XTZDAT))
- if %XTZDAT'>0
- QUIT
- FOR X=0:0
- SET X=$ORDER(^%ZTER(1,%XTZDAT,1,X))
- if X'>0
- QUIT
- IF $DATA(^(X,"ZE"))
- IF ^("ZE")[XTSTR
- SET ^TMP("XTER",$JOB,(99999-%XTZDAT),X)=%XTZDAT
- +1 QUIT
- UDD ;Convert user date
- +1 KILL XTDTE,XTDTH,XTERR
- NEW %XTF,%XTY,X,Y
- +2 if %XTZDAT?1"T".E
- GOTO T
- if %XTZDAT?1"t".E
- GOTO T
- +3 SET %XTF=$TRANSLATE(%XTZDAT,$CHAR(32,44,45,46),"////")
- B SET %XTY="//"
- DO R
- +1 SET X=%XTF
- SET %DT="XP"
- SET %DT(0)="-NOW"
- DO ^%DT
- KILL %DT
- IF Y'>0
- SET XTERR=1
- KILL XTDTE,XTDTH
- GOTO K
- +2 SET XTDTH=+$$FMTH^XLFDT(Y)
- SET XTDTE=$$FMTE^XLFDT(Y,5)
- K QUIT
- E SET XTERR=1
- KILL XTDTH,XTDTE
- GOTO K
- R if %XTF'[%XTY
- QUIT
- SET %XTF=$PIECE(%XTF,%XTY,1)_"/"_$PIECE(%XTF,%XTY,2,256)
- GOTO R
- +1 ;
- T SET %XTT=$EXTRACT(%XTZDAT,2,99)
- IF %XTT'=""
- if %XTT?7E.E
- GOTO E
- if %XTT'?1"-"1N.N&(%XTT'?1"+"1N.N)
- GOTO E
- +1 SET XTDTH=$PIECE($HOROLOG,",",1)+%XTT
- if XTDTH<0
- GOTO E
- DO UDA
- SET XTDTH=-XTDTH
- GOTO K
- +2 ;
- UDA ;
- +1 IF '$DATA(XTDTH)
- SET XTDTH=$PIECE($HOROLOG,",",1)
- +2 SET XTDTE=$$HTE^XLFDT(XTDTH,5)
- +3 QUIT
