source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XQABLIST.m@ 1474

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,".VA.GOV") S:$E(XQADRS,$L(XQADRS))="." XQADRS=$E(XQADRS,1,$L(XQADRS)-1) S XQADRS=XQADRS_".VA.GOV"
 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)