ABPAPI02 ;POST INITIALIZATION TASKS - PART 2; [ 04/18/91 9:53 AM ]
;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
;---------------------------------------------------------------------
OPTS ;PROCEDURE TO CHECK FOR AND REMOVE UNUSED OPTIONS
W !!," Checking for old, unused options..."
S ABPAMENU=$O(^DIC(19,"B","ABPAMENU","")) Q:+ABPAMENU'>0
Q:$D(^DIC(19,ABPAMENU,10,"B"))'=10
K X S R1=0 F I=0:0 D Q:+R1=0
.S R1=$O(^DIC(19,ABPAMENU,10,"B",R1)) Q:+R1=0 S X(1,R1)=""
I $D(X(1))=10 S R1=0 F I=0:0 D Q:+R1=0
.S R1=$O(X(1,R1)) Q:+R1=0
.S R2=0 F I=0:0 D Q:+R2=0
..S R2=$O(^DIC(19,R1,10,"B",R2)) Q:+R2=0 S X(2,R2)=""
I $D(X(2))=10 S R2=0 F I=0:0 D Q:+R2=0
.S R2=$O(X(2,R2)) Q:+R2=0
.S R3=0 F I=0:0 D Q:+R3=0
..S R3=$O(^DIC(19,R2,10,"B",R3)) Q:+R3=0 S X(3,R3)=""
I $D(X(3))=10 S R3=0 F I=0:0 D Q:+R3=0
.S R3=$O(X(3,R3)) Q:+R3=0
.S R4=0 F I=0:0 D Q:+R4=0
..S R4=$O(^DIC(19,R3,10,"B",R4)) Q:+R4=0 S X(4,R4)=""
I $D(X(4))=10 S R4=0 F I=0:0 D Q:+R4=0
.S R4=$O(X(4,R4)) Q:+R4=0
.S R5=0 F I=0:0 D Q:+R5=0
..S R5=$O(^DIC(19,R4,10,"B",R5)) Q:+R5=0 S X(5,R5)=""
K ABPAOPT S R=0 F I=0:0 D Q:+R=0
.S R=$O(X(R)) Q:+R=0
.S RR=0 F I=0:0 D Q:+RR=0
..S RR=$O(X(R,RR)) Q:+RR=0 S ABPAOPT(RR)=$P(^DIC(19,RR,0),"^",2)
K X,MSG S ABPAOPT(ABPAMENU)=$P(^DIC(19,ABPAMENU,0),"^",2)
S ABPAR="ABPA",MSG="no problems here!"
F I=0:0 D Q:$E(ABPAR,1,4)'="ABPA"
.S ABPAR=$O(^DIC(19,"B",ABPAR)) Q:$E(ABPAR,1,4)'="ABPA"
.Q:ABPAR["AUTO" S ABPARR=0 F J=0:0 D Q:+ABPARR=0
..S ABPARR=$O(^DIC(19,"B",ABPAR,ABPARR)) Q:+ABPARR=0
..Q:$D(^DIC(19,ABPARR,0))'=1
..I $D(ABPAOPT(ABPARR))'=1 D
...W !," Deleting the '",ABPAR,"' option." K MSG
...K DIK,DA S DIK="^DIC(19,",DA=ABPARR D ^DIK
W:$D(MSG)=1 MSG K ABPAOPT
Q
;---------------------------------------------------------------------
LOCKS ;PROCEDURE TO CHECK VALIDITY OF THE OPTION/LOCK RELATIONSHIPS
W !!," Inspecting your option/lock relationships..."
K MSG S MSG="everything looks O.K.!"
S ABPAR="ABPA" F I=0:0 D Q:$E(ABPAR,1,4)'="ABPA"
.S ABPAR=$O(^DIC(19,"B",ABPAR)) Q:$E(ABPAR,1,4)'="ABPA"
.S ABPARR=0 F J=0:0 D Q:+ABPARR=0
..S ABPARR=$O(^DIC(19,"B",ABPAR,ABPARR)) Q:+ABPARR=0
..Q:$D(^DIC(19,ABPARR,0))'=1
..S ABPALOCK="ABPAZ"_$E(ABPAR,5,99)
..I $P(^DIC(19,ABPARR,0),"^",6)]"" D
...I $P(^DIC(19,ABPARR,0),"^",6)'=ABPALOCK D
....W !," '",ABPAR,"' has the wrong lock..." K MSG
....K DIE,DA,DR S DIE="^DIC(19,",DR="3///@",DA=ABPARR D ^DIE
....W "fixed!"
I $D(MSG)=1 W MSG
Q
ABPAPI02 ;POST INITIALIZATION TASKS - PART 2; [ 04/18/91 9:53 AM ]
+1 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991
+2 ;---------------------------------------------------------------------
OPTS ;PROCEDURE TO CHECK FOR AND REMOVE UNUSED OPTIONS
+1 WRITE !!," Checking for old, unused options..."
+2 SET ABPAMENU=$ORDER(^DIC(19,"B","ABPAMENU",""))
IF +ABPAMENU'>0
QUIT
+3 IF $DATA(^DIC(19,ABPAMENU,10,"B"))'=10
QUIT
+4 KILL X
SET R1=0
FOR I=0:0
Begin DoDot:1
+5 SET R1=$ORDER(^DIC(19,ABPAMENU,10,"B",R1))
IF +R1=0
QUIT
SET X(1,R1)=""
End DoDot:1
IF +R1=0
QUIT
+6 IF $DATA(X(1))=10
SET R1=0
FOR I=0:0
Begin DoDot:1
+7 SET R1=$ORDER(X(1,R1))
IF +R1=0
QUIT
+8 SET R2=0
FOR I=0:0
Begin DoDot:2
+9 SET R2=$ORDER(^DIC(19,R1,10,"B",R2))
IF +R2=0
QUIT
SET X(2,R2)=""
End DoDot:2
IF +R2=0
QUIT
End DoDot:1
IF +R1=0
QUIT
+10 IF $DATA(X(2))=10
SET R2=0
FOR I=0:0
Begin DoDot:1
+11 SET R2=$ORDER(X(2,R2))
IF +R2=0
QUIT
+12 SET R3=0
FOR I=0:0
Begin DoDot:2
+13 SET R3=$ORDER(^DIC(19,R2,10,"B",R3))
IF +R3=0
QUIT
SET X(3,R3)=""
End DoDot:2
IF +R3=0
QUIT
End DoDot:1
IF +R2=0
QUIT
+14 IF $DATA(X(3))=10
SET R3=0
FOR I=0:0
Begin DoDot:1
+15 SET R3=$ORDER(X(3,R3))
IF +R3=0
QUIT
+16 SET R4=0
FOR I=0:0
Begin DoDot:2
+17 SET R4=$ORDER(^DIC(19,R3,10,"B",R4))
IF +R4=0
QUIT
SET X(4,R4)=""
End DoDot:2
IF +R4=0
QUIT
End DoDot:1
IF +R3=0
QUIT
+18 IF $DATA(X(4))=10
SET R4=0
FOR I=0:0
Begin DoDot:1
+19 SET R4=$ORDER(X(4,R4))
IF +R4=0
QUIT
+20 SET R5=0
FOR I=0:0
Begin DoDot:2
+21 SET R5=$ORDER(^DIC(19,R4,10,"B",R5))
IF +R5=0
QUIT
SET X(5,R5)=""
End DoDot:2
IF +R5=0
QUIT
End DoDot:1
IF +R4=0
QUIT
+22 KILL ABPAOPT
SET R=0
FOR I=0:0
Begin DoDot:1
+23 SET R=$ORDER(X(R))
IF +R=0
QUIT
+24 SET RR=0
FOR I=0:0
Begin DoDot:2
+25 SET RR=$ORDER(X(R,RR))
IF +RR=0
QUIT
SET ABPAOPT(RR)=$PIECE(^DIC(19,RR,0),"^",2)
End DoDot:2
IF +RR=0
QUIT
End DoDot:1
IF +R=0
QUIT
+26 KILL X,MSG
SET ABPAOPT(ABPAMENU)=$PIECE(^DIC(19,ABPAMENU,0),"^",2)
+27 SET ABPAR="ABPA"
SET MSG="no problems here!"
+28 FOR I=0:0
Begin DoDot:1
+29 SET ABPAR=$ORDER(^DIC(19,"B",ABPAR))
IF $EXTRACT(ABPAR,1,4)'="ABPA"
QUIT
+30 IF ABPAR["AUTO"
QUIT
SET ABPARR=0
FOR J=0:0
Begin DoDot:2
+31 SET ABPARR=$ORDER(^DIC(19,"B",ABPAR,ABPARR))
IF +ABPARR=0
QUIT
+32 IF $DATA(^DIC(19,ABPARR,0))'=1
QUIT
+33 IF $DATA(ABPAOPT(ABPARR))'=1
Begin DoDot:3
+34 WRITE !," Deleting the '",ABPAR,"' option."
KILL MSG
+35 KILL DIK,DA
SET DIK="^DIC(19,"
SET DA=ABPARR
DO ^DIK
End DoDot:3
End DoDot:2
IF +ABPARR=0
QUIT
End DoDot:1
IF $EXTRACT(ABPAR,1,4)'="ABPA"
QUIT
+36 IF $DATA(MSG)=1
WRITE MSG
KILL ABPAOPT
+37 QUIT
+38 ;---------------------------------------------------------------------
LOCKS ;PROCEDURE TO CHECK VALIDITY OF THE OPTION/LOCK RELATIONSHIPS
+1 WRITE !!," Inspecting your option/lock relationships..."
+2 KILL MSG
SET MSG="everything looks O.K.!"
+3 SET ABPAR="ABPA"
FOR I=0:0
Begin DoDot:1
+4 SET ABPAR=$ORDER(^DIC(19,"B",ABPAR))
IF $EXTRACT(ABPAR,1,4)'="ABPA"
QUIT
+5 SET ABPARR=0
FOR J=0:0
Begin DoDot:2
+6 SET ABPARR=$ORDER(^DIC(19,"B",ABPAR,ABPARR))
IF +ABPARR=0
QUIT
+7 IF $DATA(^DIC(19,ABPARR,0))'=1
QUIT
+8 SET ABPALOCK="ABPAZ"_$EXTRACT(ABPAR,5,99)
+9 IF $PIECE(^DIC(19,ABPARR,0),"^",6)]""
Begin DoDot:3
+10 IF $PIECE(^DIC(19,ABPARR,0),"^",6)'=ABPALOCK
Begin DoDot:4
+11 WRITE !," '",ABPAR,"' has the wrong lock..."
KILL MSG
+12 KILL DIE,DA,DR
SET DIE="^DIC(19,"
SET DR="3///@"
SET DA=ABPARR
DO ^DIE
+13 WRITE "fixed!"
End DoDot:4
End DoDot:3
End DoDot:2
IF +ABPARR=0
QUIT
End DoDot:1
IF $EXTRACT(ABPAR,1,4)'="ABPA"
QUIT
+14 IF $DATA(MSG)=1
WRITE MSG
+15 QUIT
