XQABLIST ;ISC-SF.SEA/JLI - LIST USAGE OF OPTIONS IN ALPHA/BETA TEST ;1/19/95 14:24
;;8.0;KERNEL;;Jul 10, 1995
;;
LOW ;
W !! S XQINCR=1 S DIC="^XTV(8989.3,1,""ABPKG"",",DIC(0)="AEQM" D ^DIC G:Y'>0 KILL S XQDA=+Y,XQPKG=$P(Y,U,2)
S %ZIS="QM" D ^%ZIS Q:POP I $D(IO("Q")) K IO("Q") S ZTRTN="DQLOW^XQABLIST",ZTDESC="ALPHA/BETA PKG LOW OPTION USAGE",ZTIO=ION,ZTSAVE("XQDA")="",ZTSAVE("XQPKG")="",ZTSAVE("XQINCR")="" D ^%ZTLOAD K ZTRTN,ZTDESC,ZTIO,ZTSAVE D KILL G LOW
DQLOW U IO D GETDATA
D ^%ZISC D KILL
Q
;
ACTUAL ;
W !! S XQINCR=0 S DIC="^XTV(8989.3,1,""ABPKG"",",DIC(0)="AEQM" D ^DIC G:Y'>0 KILL S XQDA=+Y,XQPKG=$P(Y,U,2)
S %ZIS="QM" D ^%ZIS G:POP KILL I $D(IO("Q")) K IO("Q") S ZTRTN="DQACT^XQABLIST",ZTDESC="ACTUAL ALPHA/BETA OPTION USAGE",ZTIO=ION,ZTSAVE("XQINCR")="",ZTSAVE("XQDA")="",ZTSAVE("XQPKG")="" D ^%ZTLOAD K ZTRTN,ZTIO,ZTDESC,ZTSAVE D KILL G ACTUAL
DQACT U IO D GETDATA
D ^%ZISC D KILL
Q
;
GETDATA ;
K ^TMP($J) S XQVERS=$P(^XTV(8989.3,1,"ABPKG",XQDA,0),U,4),XQDAT=$P(^(0),U,2) I XQVERS'?.E1"T"1N.N&(XQVERS'?.E1"V"1N.N) S XQVERS=+^(0),XQVERS=$S($D(^DIC(9.4,XQVERS,"VERSION")):^("VERSION"),1:"")
S XQDAT=$E(XQDAT,4,5)_"/"_$E(XQDAT,6,7)_"/"_$E(XQDAT,2,3)
F XQ1=0:0 S XQ1=$O(^XTV(8989.3,1,"ABPKG",XQDA,1,XQ1)) Q:XQ1'>0 S XQID=$P(^(XQ1,0),U) D CHECK
D OUTPUT
Q
;
CHECK S XQA=$E(XQID,1,$L(XQID)-1)_$C($A($E(XQID,$L(XQID)))-1)_"z"
F XQ2=0:0 S XQA=$O(^DIC(19,"B",XQA)) Q:XQA=""!($E(XQA,1,$L(XQID))'=XQID) I $E(XQA,$L(XQID)+1)'="Z" D CHK2
Q
;
CHK2 F XQ3=0:0 S XQ3=$O(^XTV(8989.3,1,"ABPKG",XQDA,1,XQ1,1,XQ3)) Q:XQ3'>0 S XQ4=$P(^(XQ3,0),U) Q:$E(XQA,1,$L(XQ4))=XQ4
I XQ3'>0 F XQ4=0:0 S XQ4=$O(^DIC(19,"B",XQA,XQ4)) Q:XQ4'>0 S X=$S($D(^XTV(8989.3,1,"ABOPT",XQ4,0)):+$P(^(0),U,2),1:0) S ^TMP($J,XQID,$S(XQINCR:(X+1),1:9999999-X),XQA,XQ4)=XQ4_U_X
Q
;
OUTPUT S XQID="",XQUP=0
F XQ0=0:0 Q:XQUP S XQID=$O(^TMP($J,XQID)) Q:XQID="" D SPACE F XQ1=0:0 Q:XQUP S XQ1=$O(^TMP($J,XQID,XQ1)) Q:XQ1'>0!(XQ1=9999999&'XQINCR&'$D(XQMAIL)) S XQA="" F XQ2=0:0 Q:XQUP S XQA=$O(^TMP($J,XQID,XQ1,XQA)) Q:XQA="" D OUTA
Q
;
SPACE I '$D(XQMAIL) W ! Q
S XQCNT=XQCNT+1,^TMP($J,"A",XQCNT)=" "
Q
OUTA ;
F XQ3=0:0 Q:XQUP S XQ3=$O(^TMP($J,XQID,XQ1,XQA,XQ3)) Q:XQ3'>0 S X=^(XQ3),Z=$P(X,U,2) D:$D(XQMAIL) MAIL I '$D(XQMAIL),Z'>5!'XQINCR D OUT1
Q
OUT1 ;
S Y=^DIC(19,+X,0) D:($Y+4>IOSL) HEDR Q:XQUP W !,$E($P(Y,U),1,24),?26,$P(Y,U,4)," ",$J(+Z,6)," ",$E($P(^(0),U,2),1,40)
Q
MAIL ;
S XQCNT=XQCNT+1,Y=^DIC(19,+X,0),^TMP($J,"A",XQCNT)=$E($E($P(Y,U),1,24)_XQBLNK,1,26)_$P(Y,U,4)_" "_$J(+Z,6)_" "_$E($P(Y,U,2),1,38)
Q
;
SEND ;
S XQADRS=$P(XQADRS,".DOMAIN.EXT") S:$E(XQADRS,$L(XQADRS))="." XQADRS=$E(XQADRS,1,$L(XQADRS)-1) S XQADRS=XQADRS_".DOMAIN.EXT"
S ^TMP($J,"A",1)=" "_XQPKG_" v"_XQVERS_" ALPHA BETA OPTION USAGE SINCE "_XQDAT
S ^TMP($J,"A",2)=$E("OPTION NAME"_XQBLNK,1,24)_"TYPE COUNT MENU TEXT"
S XMSUB=XQPKG_" ALPHA/BETA TEST OPTION USAGE",XMTEXT="^TMP($J,""A"",",XMY(XQADRS)="",XMY(DUZ)="" D ^XMD K XMSUB,XMTEXT,XMY
Q
;
DOMAIL S $P(XQBLNK," ",30)=" ",XQMAIL=1,XQINCR=0
F XQM1=0:0 S XQM1=$O(^XTV(8989.3,1,"ABPKG",XQM1)) Q:XQM1'>0 S XQDA=XQM1,XQPKG=+^(XQM1,0),XQADRS=$P(^(0),U,3) I XQADRS?1"G."1U.E1"@"1U.E S XQPKG=$P(^DIC(9.4,XQPKG,0),U) S XQCNT=2 D GETDATA I $D(^TMP($J,"A")) D SEND
D KILL
Q
;
HEDR S XQUP=0 I '$D(ZTQUEUED),IOST["C-" R !?15,"Enter RETURN to continue....",XQX:DTIME I '$T!(XQX[U) K XQX S XQUP=1 Q
K XQX W @IOF,!,XQPKG_" v"_XQVERS_" ALPHA/BETA OPTION USAGE SINCE "_XQDAT,!,"OPTION NAME",?24,"TYPE COUNT MENU TEXT",!
Q
;
KILL K DIC,X,XQ0,XQ1,XQ2,XQ3,XQ4,XQA,XQADRS,XQBLNK,XQCNT,XQDA,XQID,XQM1,XQMAIL,XQPKG,XQUP,Y,Z,^TMP($J)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQABLIST 3664 printed Jan 18, 2025@03:41:34 Page 2
XQABLIST ;ISC-SF.SEA/JLI - LIST USAGE OF OPTIONS IN ALPHA/BETA TEST ;1/19/95 14:24
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 ;;
LOW ;
+1 WRITE !!
SET XQINCR=1
SET DIC="^XTV(8989.3,1,""ABPKG"","
SET DIC(0)="AEQM"
DO ^DIC
if Y'>0
GOTO KILL
SET XQDA=+Y
SET XQPKG=$PIECE(Y,U,2)
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="DQLOW^XQABLIST"
SET ZTDESC="ALPHA/BETA PKG LOW OPTION USAGE"
SET ZTIO=ION
SET ZTSAVE("XQDA")=""
SET ZTSAVE("XQPKG")=""
SET ZTSAVE("XQINCR")=""
DO ^%ZTLOAD
KILL ZTRTN,ZTDESC,ZTIO,ZTSAVE
DO KILL
GOTO LOW
DQLOW USE IO
DO GETDATA
+1 DO ^%ZISC
DO KILL
+2 QUIT
+3 ;
ACTUAL ;
+1 WRITE !!
SET XQINCR=0
SET DIC="^XTV(8989.3,1,""ABPKG"","
SET DIC(0)="AEQM"
DO ^DIC
if Y'>0
GOTO KILL
SET XQDA=+Y
SET XQPKG=$PIECE(Y,U,2)
+2 SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO KILL
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="DQACT^XQABLIST"
SET ZTDESC="ACTUAL ALPHA/BETA OPTION USAGE"
SET ZTIO=ION
SET ZTSAVE("XQINCR")=""
SET ZTSAVE("XQDA")=""
SET ZTSAVE("XQPKG")=""
DO ^%ZTLOAD
KILL ZTRTN,ZTIO,ZTDESC,ZTSAVE
DO KILL
GOTO ACTUAL
DQACT USE IO
DO GETDATA
+1 DO ^%ZISC
DO KILL
+2 QUIT
+3 ;
GETDATA ;
+1 KILL ^TMP($JOB)
SET XQVERS=$PIECE(^XTV(8989.3,1,"ABPKG",XQDA,0),U,4)
SET XQDAT=$PIECE(^(0),U,2)
IF XQVERS'?.E1"T"1N.N&(XQVERS'?.E1"V"1N.N)
SET XQVERS=+^(0)
SET XQVERS=$SELECT($DATA(^DIC(9.4,XQVERS,"VERSION")):^("VERSION"),1:"")
+2 SET XQDAT=$EXTRACT(XQDAT,4,5)_"/"_$EXTRACT(XQDAT,6,7)_"/"_$EXTRACT(XQDAT,2,3)
+3 FOR XQ1=0:0
SET XQ1=$ORDER(^XTV(8989.3,1,"ABPKG",XQDA,1,XQ1))
if XQ1'>0
QUIT
SET XQID=$PIECE(^(XQ1,0),U)
DO CHECK
+4 DO OUTPUT
+5 QUIT
+6 ;
CHECK SET XQA=$EXTRACT(XQID,1,$LENGTH(XQID)-1)_$CHAR($ASCII($EXTRACT(XQID,$LENGTH(XQID)))-1)_"z"
+1 FOR XQ2=0:0
SET XQA=$ORDER(^DIC(19,"B",XQA))
if XQA=""!($EXTRACT(XQA,1,$LENGTH(XQID))'=XQID)
QUIT
IF $EXTRACT(XQA,$LENGTH(XQID)+1)'="Z"
DO CHK2
+2 QUIT
+3 ;
CHK2 FOR XQ3=0:0
SET XQ3=$ORDER(^XTV(8989.3,1,"ABPKG",XQDA,1,XQ1,1,XQ3))
if XQ3'>0
QUIT
SET XQ4=$PIECE(^(XQ3,0),U)
if $EXTRACT(XQA,1,$LENGTH(XQ4))=XQ4
QUIT
+1 IF XQ3'>0
FOR XQ4=0:0
SET XQ4=$ORDER(^DIC(19,"B",XQA,XQ4))
if XQ4'>0
QUIT
SET X=$SELECT($DATA(^XTV(8989.3,1,"ABOPT",XQ4,0)):+$PIECE(^(0),U,2),1:0)
SET ^TMP($JOB,XQID,$SELECT(XQINCR:(X+1),1:9999999-X),XQA,XQ4)=XQ4_U_X
+2 QUIT
+3 ;
OUTPUT SET XQID=""
SET XQUP=0
+1 FOR XQ0=0:0
if XQUP
QUIT
SET XQID=$ORDER(^TMP($JOB,XQID))
if XQID=""
QUIT
DO SPACE
FOR XQ1=0:0
if XQUP
QUIT
SET XQ1=$ORDER(^TMP($JOB,XQID,XQ1))
if XQ1'>0!(XQ1=9999999&'XQINCR&'$DATA(XQMAIL))
QUIT
SET XQA=""
FOR XQ2=0:0
if XQUP
QUIT
SET XQA=$ORDER(^TMP($JOB,XQID,XQ1,XQA))
if XQA=""
QUIT
DO OUTA
+2 QUIT
+3 ;
SPACE IF '$DATA(XQMAIL)
WRITE !
QUIT
+1 SET XQCNT=XQCNT+1
SET ^TMP($JOB,"A",XQCNT)=" "
+2 QUIT
OUTA ;
+1 FOR XQ3=0:0
if XQUP
QUIT
SET XQ3=$ORDER(^TMP($JOB,XQID,XQ1,XQA,XQ3))
if XQ3'>0
QUIT
SET X=^(XQ3)
SET Z=$PIECE(X,U,2)
if $DATA(XQMAIL)
DO MAIL
IF '$DATA(XQMAIL)
IF Z'>5!'XQINCR
DO OUT1
+2 QUIT
OUT1 ;
+1 SET Y=^DIC(19,+X,0)
if ($Y+4>IOSL)
DO HEDR
if XQUP
QUIT
WRITE !,$EXTRACT($PIECE(Y,U),1,24),?26,$PIECE(Y,U,4)," ",$JUSTIFY(+Z,6)," ",$EXTRACT($PIECE(^(0),U,2),1,40)
+2 QUIT
MAIL ;
+1 SET XQCNT=XQCNT+1
SET Y=^DIC(19,+X,0)
SET ^TMP($JOB,"A",XQCNT)=$EXTRACT($EXTRACT($PIECE(Y,U),1,24)_XQBLNK,1,26)_$PIECE(Y,U,4)_" "_$JUSTIFY(+Z,6)_" "_$EXTRACT($PIECE(Y,U,2),1,38)
+2 QUIT
+3 ;
SEND ;
+1 SET XQADRS=$PIECE(XQADRS,".DOMAIN.EXT")
if $EXTRACT(XQADRS,$LENGTH(XQADRS))="."
SET XQADRS=$EXTRACT(XQADRS,1,$LENGTH(XQADRS)-1)
SET XQADRS=XQADRS_".DOMAIN.EXT"
+2 SET ^TMP($JOB,"A",1)=" "_XQPKG_" v"_XQVERS_" ALPHA BETA OPTION USAGE SINCE "_XQDAT
+3 SET ^TMP($JOB,"A",2)=$EXTRACT("OPTION NAME"_XQBLNK,1,24)_"TYPE COUNT MENU TEXT"
+4 SET XMSUB=XQPKG_" ALPHA/BETA TEST OPTION USAGE"
SET XMTEXT="^TMP($J,""A"","
SET XMY(XQADRS)=""
SET XMY(DUZ)=""
DO ^XMD
KILL XMSUB,XMTEXT,XMY
+5 QUIT
+6 ;
DOMAIL SET $PIECE(XQBLNK," ",30)=" "
SET XQMAIL=1
SET XQINCR=0
+1 FOR XQM1=0:0
SET XQM1=$ORDER(^XTV(8989.3,1,"ABPKG",XQM1))
if XQM1'>0
QUIT
SET XQDA=XQM1
SET XQPKG=+^(XQM1,0)
SET XQADRS=$PIECE(^(0),U,3)
IF XQADRS?1"G."1U.E1"@"1U.E
SET XQPKG=$PIECE(^DIC(9.4,XQPKG,0),U)
SET XQCNT=2
DO GETDATA
IF $DATA(^TMP($JOB,"A"))
DO SEND
+2 DO KILL
+3 QUIT
+4 ;
HEDR SET XQUP=0
IF '$DATA(ZTQUEUED)
IF IOST["C-"
READ !?15,"Enter RETURN to continue....",XQX:DTIME
IF '$TEST!(XQX[U)
KILL XQX
SET XQUP=1
QUIT
+1 KILL XQX
WRITE @IOF,!,XQPKG_" v"_XQVERS_" ALPHA/BETA OPTION USAGE SINCE "_XQDAT,!,"OPTION NAME",?24,"TYPE COUNT MENU TEXT",!
+2 QUIT
+3 ;
KILL KILL DIC,X,XQ0,XQ1,XQ2,XQ3,XQ4,XQA,XQADRS,XQBLNK,XQCNT,XQDA,XQID,XQM1,XQMAIL,XQPKG,XQUP,Y,Z,^TMP($JOB)
