- 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
