- 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
