- 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
