ABPVPI01 ;POST INITIALIZATION TASKS; [ 06/06/91 6:47 AM ]
;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
G MAIN
;---------------------------------------------------------------------
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 ABPVR="ABPV" F I=0:0 D Q:$E(ABPVR,1,4)'="ABPV"
.S ABPVR=$O(^DIC(19,"B",ABPVR)) Q:$E(ABPVR,1,4)'="ABPV"
.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
..S ABPVLOCK="ABPVZ"_$E(ABPVR,5,99)
..I $P(^DIC(19,ABPVRR,0),"^",6)]"" D
...I $P(^DIC(19,ABPVRR,0),"^",6)'=ABPVLOCK D
....W !," '",ABPVR,"' has the wrong lock..." K MSG
....K DIE,DA,DR S DIE="^DIC(19,",DR="3///@",DA=ABPVRR D ^DIE
....W "fixed!"
I $D(MSG)=1 W MSG
Q
;---------------------------------------------------------------------
UPDATE ;PROCEDURE TO UPDATE VERSION 1.X FILE ENTRIES TO 2.0 FORMAT
Q:+$P(^ABPVFAC(0),"^",4)'>0
W !!," ...Updating your file entries to the Version 2.0 format..."
S ABPVR=0 F ABPVI=0:0 D Q:+ABPVR=0
.S ABPVR=$O(^ABPVFAC(ABPVR)) Q:+ABPVR=0
.Q:$D(^ABPVFAC(ABPVR,0))'=1 S X=$P(^(0),"^") Q:X'?1N.N
.K ^ABPVFAC("B",X,ABPVR) S X=X_"A",$P(^ABPVFAC(ABPVR,0),"^")=X
Q
;---------------------------------------------------------------------
XREF ;PROCEDURE TO VALIDATE CROSS REFERENCES
Q:+$P(^ABPVFAC(0),"^",4)'>0
W !!," ...Excuse me, I insist upon checking your file indexes..."
W !," This may take awhile. Please be patient. "
K DIK,DA S DIK="^ABPVFAC(" D IXALL^DIK W "all done!"
Q
;---------------------------------------------------------------------
MAIN ;ENTRY POINT - THE PRIMARY ROUTINE DRIVER
W *7,!!,"I HAVE TO RUN A POST-INITIALIZATION ROUTINE."
D OPTS^ABPVPI02,LOCKS,UPDATE,XREF
W !!,"POST INITIALIZATION COMPLETE!"
Q
ABPVPI01 ;POST INITIALIZATION TASKS; [ 06/06/91 6:47 AM ]
+1 ;;2.0;FACILITY PVT-INS TRACKING;*0*;IHS-OKC/KJR;AUGUST 7, 1991
+2 GOTO MAIN
+3 ;---------------------------------------------------------------------
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 ABPVR="ABPV"
FOR I=0:0
Begin DoDot:1
+4 SET ABPVR=$ORDER(^DIC(19,"B",ABPVR))
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+5 SET ABPVRR=0
FOR J=0:0
Begin DoDot:2
+6 SET ABPVRR=$ORDER(^DIC(19,"B",ABPVR,ABPVRR))
IF +ABPVRR=0
QUIT
+7 IF $DATA(^DIC(19,ABPVRR,0))'=1
QUIT
+8 SET ABPVLOCK="ABPVZ"_$EXTRACT(ABPVR,5,99)
+9 IF $PIECE(^DIC(19,ABPVRR,0),"^",6)]""
Begin DoDot:3
+10 IF $PIECE(^DIC(19,ABPVRR,0),"^",6)'=ABPVLOCK
Begin DoDot:4
+11 WRITE !," '",ABPVR,"' has the wrong lock..."
KILL MSG
+12 KILL DIE,DA,DR
SET DIE="^DIC(19,"
SET DR="3///@"
SET DA=ABPVRR
DO ^DIE
+13 WRITE "fixed!"
End DoDot:4
End DoDot:3
End DoDot:2
IF +ABPVRR=0
QUIT
End DoDot:1
IF $EXTRACT(ABPVR,1,4)'="ABPV"
QUIT
+14 IF $DATA(MSG)=1
WRITE MSG
+15 QUIT
+16 ;---------------------------------------------------------------------
UPDATE ;PROCEDURE TO UPDATE VERSION 1.X FILE ENTRIES TO 2.0 FORMAT
+1 IF +$PIECE(^ABPVFAC(0),"^",4)'>0
QUIT
+2 WRITE !!," ...Updating your file entries to the Version 2.0 format..."
+3 SET ABPVR=0
FOR ABPVI=0:0
Begin DoDot:1
+4 SET ABPVR=$ORDER(^ABPVFAC(ABPVR))
IF +ABPVR=0
QUIT
+5 IF $DATA(^ABPVFAC(ABPVR,0))'=1
QUIT
SET X=$PIECE(^(0),"^")
IF X'?1N.N
QUIT
+6 KILL ^ABPVFAC("B",X,ABPVR)
SET X=X_"A"
SET $PIECE(^ABPVFAC(ABPVR,0),"^")=X
End DoDot:1
IF +ABPVR=0
QUIT
+7 QUIT
+8 ;---------------------------------------------------------------------
XREF ;PROCEDURE TO VALIDATE CROSS REFERENCES
+1 IF +$PIECE(^ABPVFAC(0),"^",4)'>0
QUIT
+2 WRITE !!," ...Excuse me, I insist upon checking your file indexes..."
+3 WRITE !," This may take awhile. Please be patient. "
+4 KILL DIK,DA
SET DIK="^ABPVFAC("
DO IXALL^DIK
WRITE "all done!"
+5 QUIT
+6 ;---------------------------------------------------------------------
MAIN ;ENTRY POINT - THE PRIMARY ROUTINE DRIVER
+1 WRITE *7,!!,"I HAVE TO RUN A POST-INITIALIZATION ROUTINE."
+2 DO OPTS^ABPVPI02
DO LOCKS
DO UPDATE
DO XREF
+3 WRITE !!,"POST INITIALIZATION COMPLETE!"
+4 QUIT
