VistA-FOIAVistA/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQ.../XQABLIST.m

67 lines
3.5 KiB
Mathematica

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)