XQABLOAD ;ISC-SF.SEA/JLI - SETUP IF ALPHA/BETA TEST SITE ;04/17/96 13:25
;;8.0;KERNEL;**28**;Jul 10, 1995
EN(DAINSTAL) ;
N DIFROM,XPD0,XPD1,XPD,XPDV,Y,D0,DA,DIC,DIE,DIK,DLAYGO,DR,X,XMY,XMDUZ,XMSUB,XMTEXT
Q:'$D(^XPD(9.6,+$G(DAINSTAL),0)) S XPD0=^(0)
S XPD=$P(^DIC(9.4,+$P(XPD0,U,2),0),U)
S XPDV=$$VER^XPDUTL($P(XPD0,U))
X ^%ZOSF("UCI") I Y'=^%ZOSF("PROD") G KILL
S X=$G(^XPD(9.6,DAINSTAL,"ABPKG")) Q:X="" S XQADRS=$P(X,U,3) G:XQADRS="" KILL G:XQADRS'["@" KILL
S (X,XQPKG)=XPD G:X="" KILL
S DIC(0)="MX",DIC="^XTV(8989.3,1,""ABPKG"",",DA(1)=1,D0=1 D ^DIC S XQDA=+Y K DIC
S Y=$P(^XPD(9.6,DAINSTAL,"ABPKG"),U) I Y'="y" D:XQDA>0 RMVTEST G SENDMESG
D:XQDA>0 CLROPTS I XQDA'>0 S DA(1)=1,D0=1,DIC(0)="L",DLAYGO=8989.3,DIC="^XTV(8989.3,1,""ABPKG"",",DIC("P")=8989.332 D ^DIC S XQDA=+Y
D:XQDA>0 SETOPTS
;
SENDMESG ;
KILL K X1,X2,X3,XQ0,XQ1,XQ2,XQ3,XQ4,XQA,XQADRS,XQBLNK,XQC,XQD1,XQDA,XQI,XQID,XQJ,XQN,XQPKG,XQZ
Q
Q
;
SETOPTS ;
S $P(^XTV(8989.3,1,"ABPKG",XQDA,0),U,2,4)=DT_U_XQADRS_U_XPDV
F XQI=0:0 S XQI=$O(^XPD(9.6,DAINSTAL,"ABNS",XQI)) Q:XQI'>0 D
. S X=^XPD(9.6,DAINSTAL,"ABNS",XQI,0),DIC="^XTV(8989.3,1,""ABPKG"",XQDA,1,",DA(1)=XQDA,DA(2)=1,DIC(0)="ML",DLAYGO=8989.3,DIC("P")=8989.3321 D:$E(X)="%" FILE^DICN D:$E(X)'="%" ^DIC K DIC I Y>0 K XQID(X) D SET1
S XQID="" F XQI=0:0 S XQID=$O(XQID(XQID)) Q:XQID="" S DIC="^XTV(8989.3,1,""ABPKG"",XQDA,1,",DIC(0)="M",X=XQID,DA(1)=XQDA,DA(2)=1 K XQID(XQID) D ^DIC I Y>0 S DA=+Y,DIE=DIC,DR=".01///@" D ^DIE
Q
SET1 ;
S XQD1=+Y F XQJ=0:0 S XQJ=$O(^XBD(9.6,DAINSTAL,"ABNS",XQI,1,XQJ)) Q:XQJ'>0 S X=^(XQJ,0) S DIC="^XTV(8989.3,1,""ABPKG"",XQDA,1,XQD1,1,",DIC(0)="ML",DLAYGO=8989.3,DIC("P")=8989.33211,DA(3)=1,DA(2)=XQDA,DA(1)=XQD1 D ^DIC K DIC
Q
;
RMVTEST D CLROPTS S DIK="^XTV(8989.3,1,""ABPKG"",",DA(1)=1,DA=XQDA D ^DIK I $O(^XTV(8989.3,1,"ABPKG",0))'>0 K ^XTV(8989.3,1,"ABOPT")
Q
;
CLROPTS S $P(XQBLNK," ",30)=" "
K ^TMP($J,"XQAB"),^("XQOPT")
S X1=$P(^XTV(8989.3,1,"ABPKG",XQDA,0),U,2),X2=$P(^(0),U,3),X3=$P(^(0),U,4),X3=$S(X3="":$E(XPDV,1,$L(XPDV)-1)_($E(XPDV,$L(XPDV))-1),1:X3)
S ^TMP($J,"XQAB",1)=" "_XQPKG_" v"_X3_" OPTION USAGE SINCE "_$E(X1,4,5)_"-"_$E(X1,6,7)_"-"_$E(X1,2,3),^(2)=" ",XQC=2 D GETDATA I $D(^TMP($J,"XQOPT")) D OUTPUT
Q
GETDATA ;
F XQ1=0:0 S XQ1=$O(^XTV(8989.3,1,"ABPKG",XQDA,1,XQ1)) Q:XQ1'>0 S XQID=$P(^(XQ1,0),U),XQID(XQID)="" D CHECK
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 XQN=$P(^DIC(19,XQ4,0),U,1,4),X=$S($D(^XTV(8989.3,1,"ABOPT",XQ4,0)):+$P(^(0),U,2),1:0) K ^XTV(8989.3,1,"ABOPT",XQ4,0) S ^TMP($J,"XQOPT",XQID,(X+1),XQA,XQ4)=XQ4_U_X_U_XQN
Q
;
OUTPUT S XQID=""
F XQ0=0:0 S XQID=$O(^TMP($J,"XQOPT",XQID)) Q:XQID="" D SPACE F XQ1=0:0 S XQ1=$O(^TMP($J,"XQOPT",XQID,XQ1)) Q:XQ1'>0 S XQA="" F XQ2=0:0 S XQA=$O(^TMP($J,"XQOPT",XQID,XQ1,XQA)) Q:XQA="" D OUTA
S XMY(XQADRS)="",XMY(DUZ)="",XMDUZ=.5,XMSUB=XQPKG_" "_XQ3_" ALPHA/BETA TEST OPTION USAGE",XMTEXT="^TMP($J,""XQAB""," D ^XMD K ^TMP($J,"XQAB"),^("XQOPT"),XMY,XMDUZ,XMSUB,XMTEXT
Q
Q
;
SPACE S XQC=XQC+1,^TMP($J,"XQAB",XQC)=" "
Q
OUTA ;
F XQ3=0:0 S XQ3=$O(^TMP($J,"XQOPT",XQID,XQ1,XQA,XQ3)) Q:XQ3'>0 S X=^(XQ3),XQZ=$P(X,U,2),Y=$P(X,U,3,99) D MAIL
Q
MAIL ;
S XQC=XQC+1,^TMP($J,"XQAB",XQC)=$E($E($P(Y,U),1,24)_XQBLNK,1,26)_$P(Y,U,4)_" "_$J(+XQZ,6)_" "_$E($P(Y,U,2),1,38)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQABLOAD 3638 printed Dec 13, 2024@02:40:28 Page 2
XQABLOAD ;ISC-SF.SEA/JLI - SETUP IF ALPHA/BETA TEST SITE ;04/17/96 13:25
+1 ;;8.0;KERNEL;**28**;Jul 10, 1995
EN(DAINSTAL) ;
+1 NEW DIFROM,XPD0,XPD1,XPD,XPDV,Y,D0,DA,DIC,DIE,DIK,DLAYGO,DR,X,XMY,XMDUZ,XMSUB,XMTEXT
+2 if '$DATA(^XPD(9.6,+$GET(DAINSTAL),0))
QUIT
SET XPD0=^(0)
+3 SET XPD=$PIECE(^DIC(9.4,+$PIECE(XPD0,U,2),0),U)
+4 SET XPDV=$$VER^XPDUTL($PIECE(XPD0,U))
+5 XECUTE ^%ZOSF("UCI")
IF Y'=^%ZOSF("PROD")
GOTO KILL
+6 SET X=$GET(^XPD(9.6,DAINSTAL,"ABPKG"))
if X=""
QUIT
SET XQADRS=$PIECE(X,U,3)
if XQADRS=""
GOTO KILL
if XQADRS'["@"
GOTO KILL
+7 SET (X,XQPKG)=XPD
if X=""
GOTO KILL
+8 SET DIC(0)="MX"
SET DIC="^XTV(8989.3,1,""ABPKG"","
SET DA(1)=1
SET D0=1
DO ^DIC
SET XQDA=+Y
KILL DIC
+9 SET Y=$PIECE(^XPD(9.6,DAINSTAL,"ABPKG"),U)
IF Y'="y"
if XQDA>0
DO RMVTEST
GOTO SENDMESG
+10 if XQDA>0
DO CLROPTS
IF XQDA'>0
SET DA(1)=1
SET D0=1
SET DIC(0)="L"
SET DLAYGO=8989.3
SET DIC="^XTV(8989.3,1,""ABPKG"","
SET DIC("P")=8989.332
DO ^DIC
SET XQDA=+Y
+11 if XQDA>0
DO SETOPTS
+12 ;
SENDMESG ;
KILL KILL X1,X2,X3,XQ0,XQ1,XQ2,XQ3,XQ4,XQA,XQADRS,XQBLNK,XQC,XQD1,XQDA,XQI,XQID,XQJ,XQN,XQPKG,XQZ
+1 QUIT
+2 QUIT
+3 ;
SETOPTS ;
+1 SET $PIECE(^XTV(8989.3,1,"ABPKG",XQDA,0),U,2,4)=DT_U_XQADRS_U_XPDV
+2 FOR XQI=0:0
SET XQI=$ORDER(^XPD(9.6,DAINSTAL,"ABNS",XQI))
if XQI'>0
QUIT
Begin DoDot:1
+3 SET X=^XPD(9.6,DAINSTAL,"ABNS",XQI,0)
SET DIC="^XTV(8989.3,1,""ABPKG"",XQDA,1,"
SET DA(1)=XQDA
SET DA(2)=1
SET DIC(0)="ML"
SET DLAYGO=8989.3
SET DIC("P")=8989.3321
if $EXTRACT(X)="%"
DO FILE^DICN
if $EXTRACT(X)'="%"
DO ^DIC
KILL DIC
IF Y>0
KILL XQID(X)
DO SET1
End DoDot:1
+4 SET XQID=""
FOR XQI=0:0
SET XQID=$ORDER(XQID(XQID))
if XQID=""
QUIT
SET DIC="^XTV(8989.3,1,""ABPKG"",XQDA,1,"
SET DIC(0)="M"
SET X=XQID
SET DA(1)=XQDA
SET DA(2)=1
KILL XQID(XQID)
DO ^DIC
IF Y>0
SET DA=+Y
SET DIE=DIC
SET DR=".01///@"
DO ^DIE
+5 QUIT
SET1 ;
+1 SET XQD1=+Y
FOR XQJ=0:0
SET XQJ=$ORDER(^XBD(9.6,DAINSTAL,"ABNS",XQI,1,XQJ))
if XQJ'>0
QUIT
SET X=^(XQJ,0)
SET DIC="^XTV(8989.3,1,""ABPKG"",XQDA,1,XQD1,1,"
SET DIC(0)="ML"
SET DLAYGO=8989.3
SET DIC("P")=8989.33211
SET DA(3)=1
SET DA(2)=XQDA
SET DA(1)=XQD1
DO ^DIC
KILL DIC
+2 QUIT
+3 ;
RMVTEST DO CLROPTS
SET DIK="^XTV(8989.3,1,""ABPKG"","
SET DA(1)=1
SET DA=XQDA
DO ^DIK
IF $ORDER(^XTV(8989.3,1,"ABPKG",0))'>0
KILL ^XTV(8989.3,1,"ABOPT")
+1 QUIT
+2 ;
CLROPTS SET $PIECE(XQBLNK," ",30)=" "
+1 KILL ^TMP($JOB,"XQAB"),^("XQOPT")
+2 SET X1=$PIECE(^XTV(8989.3,1,"ABPKG",XQDA,0),U,2)
SET X2=$PIECE(^(0),U,3)
SET X3=$PIECE(^(0),U,4)
SET X3=$SELECT(X3="":$EXTRACT(XPDV,1,$LENGTH(XPDV)-1)_($EXTRACT(XPDV,$LENGTH(XPDV))-1),1:X3)
+3 SET ^TMP($JOB,"XQAB",1)=" "_XQPKG_" v"_X3_" OPTION USAGE SINCE "_$EXTRACT(X1,4,5)_"-"_$EXTRACT(X1,6,7)_"-"_$EXTRACT(X1,2,3)
SET ^(2)=" "
SET XQC=2
DO GETDATA
IF $DATA(^TMP($JOB,"XQOPT"))
DO OUTPUT
+4 QUIT
GETDATA ;
+1 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)
SET XQID(XQID)=""
DO CHECK
+2 QUIT
+3 ;
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 XQN=$PIECE(^DIC(19,XQ4,0),U,1,4)
SET X=$SELECT($DATA(^XTV(8989.3,1,"ABOPT",XQ4,0)):+$PIECE(^(0),U,2),1:0)
KILL ^XTV(8989.3,1,"ABOPT",XQ4,0)
SET ^TMP($JOB,"XQOPT",XQID,(X+1),XQA,XQ4)=XQ4_U_X_U_XQN
+2 QUIT
+3 ;
OUTPUT SET XQID=""
+1 FOR XQ0=0:0
SET XQID=$ORDER(^TMP($JOB,"XQOPT",XQID))
if XQID=""
QUIT
DO SPACE
FOR XQ1=0:0
SET XQ1=$ORDER(^TMP($JOB,"XQOPT",XQID,XQ1))
if XQ1'>0
QUIT
SET XQA=""
FOR XQ2=0:0
SET XQA=$ORDER(^TMP($JOB,"XQOPT",XQID,XQ1,XQA))
if XQA=""
QUIT
DO OUTA
+2 SET XMY(XQADRS)=""
SET XMY(DUZ)=""
SET XMDUZ=.5
SET XMSUB=XQPKG_" "_XQ3_" ALPHA/BETA TEST OPTION USAGE"
SET XMTEXT="^TMP($J,""XQAB"","
DO ^XMD
KILL ^TMP($JOB,"XQAB"),^("XQOPT"),XMY,XMDUZ,XMSUB,XMTEXT
+3 QUIT
+4 QUIT
+5 ;
SPACE SET XQC=XQC+1
SET ^TMP($JOB,"XQAB",XQC)=" "
+1 QUIT
OUTA ;
+1 FOR XQ3=0:0
SET XQ3=$ORDER(^TMP($JOB,"XQOPT",XQID,XQ1,XQA,XQ3))
if XQ3'>0
QUIT
SET X=^(XQ3)
SET XQZ=$PIECE(X,U,2)
SET Y=$PIECE(X,U,3,99)
DO MAIL
+2 QUIT
MAIL ;
+1 SET XQC=XQC+1
SET ^TMP($JOB,"XQAB",XQC)=$EXTRACT($EXTRACT($PIECE(Y,U),1,24)_XQBLNK,1,26)_$PIECE(Y,U,4)_" "_$JUSTIFY(+XQZ,6)_" "_$EXTRACT($PIECE(Y,U,2),1,38)
+2 QUIT
+3 ;
