ABPVPI02 ;POST INITIALIZATION TASKS - PART 2; [ 06/03/91 10:10 AM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
W !!,"NOT AN ENTRY POINT!",!! Q
;---------------------------------------------------------------------
OPTS ;PROCEDURE TO CHECK FOR AND REMOVE UNUSED OPTIONS
W !!," Checking for old, unused options..."
S ABPVMENU=$O(^DIC(19,"B","ABPVMENU","")) Q:+ABPVMENU'>0
Q:$D(^DIC(19,ABPVMENU,10,"B"))'=10
K X S R1=0 F I=0:0 D Q:+R1=0
.S R1=$O(^DIC(19,ABPVMENU,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 ABPVOPT 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 ABPVOPT(RR)=$P(^DIC(19,RR,0),"^",2)
K X,MSG S ABPVOPT(ABPVMENU)=$P(^DIC(19,ABPVMENU,0),"^",2)
S ABPVR="ABPV",MSG="no problems here!"
F I=0:0 D Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVR=$O(^DIC(19,"B",ABPVR)) Q:$E(ABPVR,1,4)'="ABPV"
.Q:ABPVR["AUTO" S ABPVRR=0 F J=0:0 D Q:+ABPVRR=0
..S ABPVRR=$O(^DIC(19,"B",ABPVR,ABPVRR)) Q:+ABPVRR=0
..Q:$D(^DIC(19,ABPVRR,0))'=1
..I $D(ABPVOPT(ABPVRR))'=1 D
...W !," Deleting the '",ABPVR,"' option." K MSG
...K DIK,DA S DIK="^DIC(19,",DA=ABPVRR D ^DIK
W:$D(MSG)=1 MSG K ABPVOPT
Q
ABPVPI02 ;POST INITIALIZATION TASKS - PART 2; [ 06/03/91 10:10 AM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
+2 WRITE !!,"NOT AN ENTRY POINT!",!!
QUIT
+3 ;---------------------------------------------------------------------
OPTS ;PROCEDURE TO CHECK FOR AND REMOVE UNUSED OPTIONS
+1 WRITE !!," Checking for old, unused options..."
+2 SET ABPVMENU=$ORDER(^DIC(19,"B","ABPVMENU",""))
IF +ABPVMENU'>0
QUIT
+3 IF $DATA(^DIC(19,ABPVMENU,10,"B"))'=10
QUIT
+4 KILL X
SET R1=0
FOR I=0:0
Begin DoDot:1
+5 SET R1=$ORDER(^DIC(19,ABPVMENU,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 ABPVOPT
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 ABPVOPT(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 ABPVOPT(ABPVMENU)=$PIECE(^DIC(19,ABPVMENU,0),"^",2)
+27 SET ABPVR="ABPV"
SET MSG="no problems here!"
+28 FOR I=0:0
Begin DoDot:1
+29 SET ABPVR=$ORDER(^DIC(19,"B",ABPVR))
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+30 IF ABPVR["AUTO"
QUIT
SET ABPVRR=0
FOR J=0:0
Begin DoDot:2
+31 SET ABPVRR=$ORDER(^DIC(19,"B",ABPVR,ABPVRR))
IF +ABPVRR=0
QUIT
+32 IF $DATA(^DIC(19,ABPVRR,0))'=1
QUIT
+33 IF $DATA(ABPVOPT(ABPVRR))'=1
Begin DoDot:3
+34 WRITE !," Deleting the '",ABPVR,"' option."
KILL MSG
+35 KILL DIK,DA
SET DIK="^DIC(19,"
SET DA=ABPVRR
DO ^DIK
End DoDot:3
End DoDot:2
IF +ABPVRR=0
QUIT
End DoDot:1
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+36 IF $DATA(MSG)=1
WRITE MSG
KILL ABPVOPT
+37 QUIT
